MODULE IbisOutput USE Constants, ONLY: & r8, & r4, & i8, & pi IMPLICIT NONE INTEGER :: nnVeg=-1 INTEGER :: nSoil=-1 INTEGER :: nVars=-1 INTEGER :: nVarscp=-1 INTEGER :: ibMax =-1 INTEGER :: jbMax =-1 INTEGER ,ALLOCATABLE :: nLevs(:) REAL(KIND=r8) ,ALLOCATABLE :: depth(:) INTEGER ,ALLOCATABLE :: nLevscp(:) REAL(KIND=r8) ,ALLOCATABLE :: depthcp(:) TYPE GRADS CHARACTER(LEN= 20) :: Units ='K' CHARACTER(LEN=555) :: Name ='Temperature' CHARACTER(LEN= 10) :: NameG ='Temp' INTEGER :: ibMax =1 INTEGER :: jbMax =1 INTEGER :: nVars =1 INTEGER :: nSoil =3 INTEGER :: nLevs =1 REAL(KIND=r4) , POINTER :: Buffer (:,:,:) END TYPE GRADS TYPE(GRADS), ALLOCATABLE :: Grd(:) TYPE GRADS2 CHARACTER(LEN= 20) :: Units ='K' CHARACTER(LEN=555) :: Name ='Temperature' CHARACTER(LEN= 10) :: NameG ='Temp' INTEGER :: ibMax =1 INTEGER :: jbMax =1 INTEGER :: nVars =1 INTEGER :: nnVeg =8 INTEGER :: nLevs =1 REAL(KIND=r4) , POINTER :: Buffer2 (:,:,:) END TYPE GRADS2 TYPE(GRADS2), ALLOCATABLE :: Grd_CP(:) INTEGER :: step REAL(KIND=r8) :: undef= -9.99E+33 REAL(KIND=r8) :: maxstp= 0 LOGICAL :: OPENFILE=.TRUE. LOGICAL :: OPENFILE_CTL=.TRUE. LOGICAL :: OPENFILE_CP=.TRUE. LOGICAL :: OPENFILE_CTL_CP=.TRUE. INTEGER :: NumberRec=0 INTEGER :: NumberRecCP=0 CONTAINS SUBROUTINE Init_IbisOutput(nVars_Input,nVarscp_Input,ibMax_Input,jbMax_Input,nSoil_Input,DELTAOUT,dt,depth_in) IMPLICIT NONE INTEGER, INTENT(IN ) :: nVars_Input INTEGER, INTENT(IN ) :: nVarscp_Input INTEGER, INTENT(IN ) :: ibMax_Input INTEGER, INTENT(IN ) :: jbMax_Input INTEGER, INTENT(IN ) :: nSoil_Input REAL(KIND=r8), INTENT(IN ) :: DELTAOUT REAL(KIND=r8), INTENT(IN ) :: dt REAL(KIND=r8), INTENT(IN ) :: depth_in(nSoil_Input) INTEGER :: k INTEGER :: i INTEGER :: j nVars = nVars_Input nVarscp = nVarscp_Input nSoil = nSoil_Input nnVeg = 8 ibMax = ibMax_Input jbMax = jbMax_Input ALLOCATE(nLevs(nVars)) ALLOCATE(nLevscp(nVarscp)) ALLOCATE(Grd(nVars)) ALLOCATE(Grd_CP(nVarscp)) ALLOCATE(depth(nSoil_Input)) ALLOCATE(depthcp(nnVeg)) depth = depth_in depthcp = (/1.,2.,3.,4.,5.,6.,7.,8./) nLevscp(1:nVarscp)=(/nnVeg ,nnVeg ,nnVeg ,nnVeg ,nnVeg /) ! 01-05 nLevs(1:nVars)=(/1 ,1 ,1 ,nSoil_Input,1 ,& ! 01-05 nSoil_Input,1 ,1 ,1 ,1 ,& ! 06-10 1 ,1 ,1 ,1 ,1 ,& ! 11-15 1 ,1 ,1 ,1 ,1 ,& ! 16-20 1 ,1 ,1 ,1 ,1 ,& ! 21-25 1 ,1 ,1 ,1 ,1 ,& ! 26-30 1 ,1 ,1 ,1 ,1 ,& ! 31-35 1 ,1 ,1 ,1 ,1 ,& ! 36-40 1 ,nSoil_Input,nSoil_Input,1 ,1 ,& ! 41-45 1 ,1 ,1 ,1 ,1 ,& ! 46-50 1 ,1 ,1 ,1 ,1 ,& ! 51-55 1 ,1 ,1 ,1 ,1 ,& ! 56-60 1 ,1 ,1 ,1 ,1 ,& ! 61-65 1 ,1 ,1 ,nSoil_Input,nSoil_Input,& ! 66 70 nSoil_Input,nSoil_Input,1 ,1 ,1 ,& ! 71-75 1 ,1 ,1 ,1 ,1 ,& ! 76-80 1 ,1 ,1 ,1 ,1 ,& ! 81-85 1 ,1 ,1 ,1 ,1 ,& ! 86-90 1 ,1 ,1 ,1 ,1 ,& ! 91-95 1 ,1 ,1 ,1 ,1 ,& ! 96-100 1 ,1 ,1 ,1 ,1 ,& ! 101-105 1 ,1 ,1 ,1 ,1 ,& ! 106-110 1 ,1 ,1 ,1 ,1 ,& ! 111-115 1 ,1 ,1 ,1 ,1 ,& ! 116-120 1 ,1 ,1 ,1 ,1 ,& ! 121-125 1 ,1 ,1 ,1 ,1 ,& ! 126-130 1 ,1 ,1 ,1 ,1 ,& ! 131-135 1 ,1 ,1 ,1 ,1 ,& ! 136-140 1 ,1 ,1 ,1 ,1 ,& ! 141-145 1 ,1 ,1 ,1 ,1 ,& ! 146-150 1 ,1 ,1 ,1 ,1 ,& ! 151-155 1 ,1 ,1 ,1 ,1 ,& ! 156-160 1 ,1 ,1 ,1 ,1 ,& ! 161-165 1 ,1 ,1 ,1 ,1 ,& ! 166-170 1 ,1 ,1 ,1 ,1 ,& ! 171-175 1 ,1 ,1 ,1 ,1 ,& ! 176-180 1 ,1 ,1 ,1 ,1 ,& ! 181-185 1 ,1 ,1 ,1 ,1 ,& ! 186-190 1 ,1 ,1 ,1 ,1 ,& ! 191-195 1 ,1 ,1 ,1 ,1 ,& ! 196-200 1 ,1 ,1 ,1 ,1 ,& ! 201-205 1 ,1 ,1 ,1 ,1 ,& ! 206-210 1 ,1 ,1 ,1 ,1 ,& ! 211-215 1 ,1 ,1 ,1 ,1 ,& ! 216-220 1 ,1 ,1 ,1 ,1 ,& ! 221-225 1 ,1 ,1 ,1 ,1 ,& ! 226-230 1 ,1 ,1 ,1 ,1 ,& ! 231-235 1 ,1 ,1 ,1 ,1 ,& ! 236-240 1 ,1 ,1 ,1 ,1 ,& ! 241-245 1 ,1 ,1 ,1 ,1 ,& ! 246-250 1 ,1 ,1 ,1 ,1 ,& ! 251-255 1 ,1 ,1 ,1 ,1 ,& ! 256-260 1 ,1 ,1 ,1 ,1 ,& ! 261-265 1 ,1 ,1 ,1 ,1 ,& ! 266-270 1 ,1 ,1 ,1 ,1 ,& ! 271-275 1 ,1 ,1 ,1 ,1 ,& ! 276-280 1 ,1 ,1 ,1 ,1 ,& ! 281-285 1 ,1 ,1 ,1 ,1 ,& ! 286-290 1 ,1 ,1 ,1 ,1 ,& ! 291-295 1 ,1 ,1 ,1 ,1 ,& ! 296-300 1 ,1 ,1 ,1 ,1 ,& ! 301-305 1 ,1 ,1 ,1 ,1 ,& ! 306-310 1 ,1 ,1 ,1 ,1 ,& ! 311-315 1 ,1 ,1 ,1 ,1 ,& ! 316-320 1 ,1 ,1 ,1 ,1 ,& ! 321-325 1 ,1 ,1 ,1 ,1 ,& ! 326-330 1 ,1 ,1 ,1 ,1 ,& ! 331-335 1 ,1 ,1 ,1 ,1 ,& ! 336-340 1 ,1 ,1 ,1 ,1 ,& ! 341-345 1 ,1 ,1 ,1 ,1 ,& ! 346-350 1 ,1 ,1 ,1 ,1 ,& ! 351-355 1 ,1 ,1 ,1 ,1 ,& ! 356-360 1 ,1 ,1 ,1 ,1 ,& ! 361-365 1 ,1 ,1 ,1 ,1 ,& ! 366-370 1 ,1 ,1 ,1 ,1 ,& ! 371-375 1 ,1 ,1 ,1 ,1 ,& ! 376-380 1 ,1 ,1 ,1 ,1 ,& ! 381-385 1 ,1 ,1 ,1 ,1 ,& ! 386-390 1 ,1 ,1 ,1 ,1 ,& ! 391-395 1 ,1 ,1 ,1 ,1 ,& ! 396-400 1 ,1 ,1 ,1 ,1 ,& ! 401-405 1 ,1 ,1 ,1 ,1 /) ! 406-410 DO k=1,nVars_Input Grd(k)%Units='K' Grd(k)%Name='Temperature' Grd(k)%NameG='TEMP' Grd(k)%ibMax=ibMax Grd(k)%jbMax=jbMax Grd(k)%nVars=nVars_Input Grd(k)%nSoil=nSoil_Input Grd(k)%nLevs=nLevs(k) END DO DO k=1,nVarscp Grd_CP(k)%Units='K' Grd_CP(k)%Name='Temperature' Grd_CP(k)%NameG='TEMP' Grd_CP(k)%ibMax=ibMax Grd_CP(k)%jbMax=jbMax Grd_CP(k)%nVars=nVarscp Grd_CP(k)%nnVeg=nnVeg Grd_CP(k)%nLevs=nLevscp(k) END DO maxstp = dt/DELTAOUT DO k=1,nVars CALL NULLIFING(Grd( k ),nLevs(k)) END DO DO k=1,nVarscp CALL NULLIFING2(Grd_CP( k ),nLevscp(k)) END DO END SUBROUTINE Init_IbisOutput SUBROUTINE RunOutput1D_Grads(jdt,tod,nband,dt,idate,idatec,idatep,DELTAOUT,latic,longc) IMPLICIT NONE REAL(KIND=r8) , INTENT(IN ) :: tod INTEGER , INTENT(IN ) :: jdt INTEGER , INTENT(IN ) :: nband ! INTENT(IN ) :: nband REAL(KIND=r8) , INTENT(IN ) :: dt ! INTENT(IN ) :: dt INTEGER , INTENT(IN ) :: idate (4) ! INTENT(IN ) :: idatec(:) INTEGER , INTENT(IN ) :: idatec(4) ! INTENT(IN ) :: idatec(:) INTEGER , INTENT(IN ) :: idatep(4) REAL(KIND=r8) , INTENT(IN ) :: DELTAOUT REAL(KIND=r8) , INTENT(IN ) :: latic(:,:) REAL(KIND=r8) , INTENT(IN ) :: longc(:,:) REAL(KIND=r4) :: dumpdata REAL(KIND=r8) :: time INTEGER :: lrec INTEGER :: deltat INTEGER :: nCols INTEGER :: irec INTEGER :: reclen INTEGER :: open_status INTEGER :: ios INTEGER, PARAMETER :: input_unit=100 INTEGER, PARAMETER :: input_unit_ctl=90 INTEGER, PARAMETER :: ok = 0 CHARACTER(LEN=255) :: PREFIX='OUTPUTIBIS' CHARACTER(LEN=255) :: SUFFIX='.bin' CHARACTER(LEN=255) :: namec CHARACTER(LEN=255) :: namectl CHARACTER(LEN=20) :: dump=' ' CHARACTER(LEN=3) :: clday(12)=(/'JAN','FEB','MAR','APR','MAY','JUN',& 'JUL','AUG','SEP','OCT','NOV','DEC'/) CHARACTER(LEN=12) :: date INTEGER :: k,i,j,ib,ll nCols=ibMax time =tod open_status = ok IF(MOD(tod,DELTAOUT) == 0.0_r8 )THEN step=0 DO i=1,ibMax WRITE(namec,'(A16,I3.3)')'SAIDAMODELIBIS.S',i IF(OPENFILE_CTL)OPEN(input_unit_ctl+i,FILE='./outputdata/'//TRIM(namec)//'.ctl',ACCESS='SEQUENTIAL',& FORM='FORMATTED',STATUS='UNKNOWN',ACTION='WRITE', & IOSTAT=open_status) IF( open_status == ok ) THEN IF(OPENFILE_CTL)THEN WRITE(input_unit_ctl+i,'(A6,A )',iostat = ios)'dset ^',TRIM(namec)//'.bin' WRITE(input_unit_ctl+i,'(A )',iostat = ios)'*' WRITE(input_unit_ctl+i,'(A6,E12.5 )',iostat = ios)'undef ',undef WRITE(input_unit_ctl+i,'(A )',iostat = ios)'*' WRITE(input_unit_ctl+i,'(A6,A )',iostat = ios)'title ',TRIM(namec) WRITE(input_unit_ctl+i,'(A )',iostat = ios)'*' WRITE(input_unit_ctl+i,'(A )',iostat = ios)'options yrev big_endian' WRITE(input_unit_ctl+i,'(A6,A,A,E12.5,A )',iostat = ios)'xdef ','1',' linear ', longc(1,1),' 1.000000' WRITE(input_unit_ctl+i,'(A6,A,A,E12.5,A )',iostat = ios)'ydef ','1',' linear ', latic(1,1),' 1.000000' WRITE(input_unit_ctl+1,'(A6,I5,A10 )',iostat = ios)'zdef ', Grd(1)%nSoil,' levels ' WRITE(input_unit_ctl+1,'(10F10.2)')(depth(Grd(1)%nSoil-k+1),k=1,Grd(1)%nSoil) WRITE(date,'(I2.2,A1,I2.2,A3,I4.4)')idate(1),'Z',idate(3),clday(idate(2)),idate(4) deltat=DELTAOUT/60.0 WRITE(input_unit_ctl+1,'(A6,A10,A10,A12,a,I10,A2)')'tdef ','1000000 ',' linear ',date,' ',deltat,'mn' WRITE(input_unit_ctl+i,'(A6,I5 )',iostat = ios)'VARS ',Grd(1)%nVars DO k=1,nVars IF(Grd(k)%nLevs==1)THEN WRITE(input_unit_ctl+1,'(A10,I5,A4,A,A2,A,A2)',iostat = ios)& Grd(k)%NameG,Grd(k)%nLevs-1,' 99 ',TRIM(Grd(k)%Name),'[ ',TRIM(Grd(k)%Units),' ]' ELSE WRITE(input_unit_ctl+1,'(A10,I5,A4,A,A2,A,A2)',iostat = ios)& Grd(k)%NameG,Grd(k)%nLevs,' 99 ',TRIM(Grd(k)%Name),'[ ',TRIM(Grd(k)%Units),' ]' END IF END DO WRITE(input_unit_ctl+i,'(A )',iostat = ios)'ENDVARS' CLOSE(input_unit_ctl+i,STATUS='KEEP') END IF ELSE WRITE(0,*)"Unable to OPEN file";STOP END IF WRITE(namec,'(A16,I3.3)')'SAIDAMODELIBIS.S',i INQUIRE(IOLENGTH=lrec)dumpdata IF(OPENFILE)OPEN(input_unit+i,FILE='./outputdata/'//TRIM(namec)//'.bin',ACCESS='DIRECT',& FORM='UNFORMATTED',STATUS='UNKNOWN',ACTION='WRITE',RECL=lrec, & IOSTAT=open_status) IF( open_status == ok ) THEN DO j=1,jbMax DO k=1,nVars DO ll=1,nLevs(k) NumberRec=NumberRec+1 WRITE(input_unit+i,rec=NumberRec,iostat = ios)Grd(k)%Buffer(i,ll,j);IF(ios /= 0) STOP Grd(k)%Buffer(i,ll,j) =0.0_r8 END DO END DO ! WRITE(input_unit+i,'(3I15,F15.4,51E15.5)',iostat = ios)& ! idatec(4),idatec(2),idatec(3),REAL(idatec(1))+((tod/3600.0_r8) - int(tod/3600.0_r8)),& ! Grd(1)%Buffer(i,1,j),Grd(2)%Buffer(i,1,j),Grd(3)%Buffer(i,1,j),& ! Grd(4)%Buffer(i,1,j),Grd(4)%Buffer(i,2,j),Grd(4)%Buffer(i,3,j),& ! Grd(4)%Buffer(i,4,j),Grd(4)%Buffer(i,5,j),Grd(4)%Buffer(i,6,j),& ! Grd(5)%Buffer(i,1,j),Grd(6)%Buffer(i,1,j),Grd(6)%Buffer(i,2,j),& ! Grd(6)%Buffer(i,3,j),Grd(6)%Buffer(i,4,j),Grd(6)%Buffer(i,5,j),Grd(6)%Buffer(i,6,j),& ! Grd(7)%Buffer(i,1,j),Grd(8)%Buffer(i,1,j),Grd(9)%Buffer(i,1,j),Grd(10)%Buffer(i,1,j),& ! Grd(11)%Buffer(i,1,j),Grd(12)%Buffer(i,1,j),Grd(13)%Buffer(i,1,j),Grd(14)%Buffer(i,1,j),& ! Grd(15)%Buffer(i,1,j),Grd(16)%Buffer(i,1,j),Grd(17)%Buffer(i,1,j),Grd(18)%Buffer(i,1,j),& ! Grd(19)%Buffer(i,1,j),Grd(20)%Buffer(i,1,j),Grd(21)%Buffer(i,1,j),Grd(22)%Buffer(i,1,j),& ! Grd(23)%Buffer(i,1,j),Grd(24)%Buffer(i,1,j),Grd(25)%Buffer(i,1,j),Grd(26)%Buffer(i,1,j),& ! Grd(27)%Buffer(i,1,j),Grd(28)%Buffer(i,1,j),Grd(29)%Buffer(i,1,j),Grd(30)%Buffer(i,1,j),& ! Grd(31)%Buffer(i,1,j),Grd(32)%Buffer(i,1,j),Grd(33)%Buffer(i,1,j),Grd(34)%Buffer(i,1,j),& ! Grd(35)%Buffer(i,1,j),Grd(36)%Buffer(i,1,j),Grd(37)%Buffer(i,1,j),Grd(38)%Buffer(i,1,j),& ! Grd(38)%Buffer(i,1,j),Grd(40)%Buffer(i,1,j),Grd(41)%Buffer(i,1,j) END DO ELSE WRITE(0,*)"Unable to OPEN file";STOP END IF END DO OPENFILE=.FALSE. OPENFILE_CTL=.FALSE. END IF END SUBROUTINE RunOutput1D_Grads SUBROUTINE RunOutput1D_Grads2(jdt,tod,nband,dt,idate,idatec,idatep,DELTAOUT,latic,longc) IMPLICIT NONE REAL(KIND=r8) , INTENT(IN ) :: tod INTEGER , INTENT(IN ) :: jdt INTEGER , INTENT(IN ) :: nband ! INTENT(IN ) :: nband REAL(KIND=r8) , INTENT(IN ) :: dt ! INTENT(IN ) :: dt INTEGER , INTENT(IN ) :: idate (4) ! INTENT(IN ) :: idatec(:) INTEGER , INTENT(IN ) :: idatec(4) ! INTENT(IN ) :: idatec(:) INTEGER , INTENT(IN ) :: idatep(4) REAL(KIND=r8) , INTENT(IN ) :: DELTAOUT REAL(KIND=r8) , INTENT(IN ) :: latic(:,:) REAL(KIND=r8) , INTENT(IN ) :: longc(:,:) REAL(KIND=r4) :: dumpdata REAL(KIND=r8) :: time INTEGER :: lrec INTEGER :: deltat INTEGER :: nCols INTEGER :: irec INTEGER :: reclen INTEGER :: open_status INTEGER :: ios INTEGER, PARAMETER :: input_unit2=50 INTEGER, PARAMETER :: input_unit_ctl2=70 INTEGER, PARAMETER :: ok = 0 CHARACTER(LEN=255) :: PREFIX='CANOPY_OUTPUTIBIS' CHARACTER(LEN=255) :: SUFFIX='.bin' CHARACTER(LEN=255) :: namec CHARACTER(LEN=255) :: namectl CHARACTER(LEN=20) :: dump=' ' CHARACTER(LEN=3) :: clday(12)=(/'JAN','FEB','MAR','APR','MAY','JUN',& 'JUL','AUG','SEP','OCT','NOV','DEC'/) CHARACTER(LEN=12) :: date INTEGER :: k,i,j,ib,ll nCols=ibMax time =tod open_status = ok IF(MOD(tod,DELTAOUT) == 0.0_r8 )THEN step=0 DO i=1,ibMax WRITE(namec,'(A19,I3.3)')'CANOPY_OUTPUTIBIS.S',i IF(OPENFILE_CTL_CP)OPEN(input_unit_ctl2+i,FILE='./outputdata/'//TRIM(namec)//'.ctl',ACCESS='SEQUENTIAL',& FORM='FORMATTED',STATUS='UNKNOWN',ACTION='WRITE', & IOSTAT=open_status) IF( open_status == ok ) THEN IF(OPENFILE_CTL_CP)THEN WRITE(input_unit_ctl2+i,'(A6,A )',iostat = ios)'dset ^',TRIM(namec)//'.bin' WRITE(input_unit_ctl2+i,'(A )',iostat = ios)'*' WRITE(input_unit_ctl2+i,'(A6,E12.5 )',iostat = ios)'undef ',undef WRITE(input_unit_ctl2+i,'(A )',iostat = ios)'*' WRITE(input_unit_ctl2+i,'(A6,A )',iostat = ios)'title ',TRIM(namec) WRITE(input_unit_ctl2+i,'(A )',iostat = ios)'*' WRITE(input_unit_ctl2+i,'(A )',iostat = ios)'options yrev big_endian' WRITE(input_unit_ctl2+i,'(A6,A,A,E12.5,A )',iostat = ios)'xdef ','1',' linear ', longc(1,1),' 1.000000' WRITE(input_unit_ctl2+i,'(A6,A,A,E12.5,A )',iostat = ios)'ydef ','1',' linear ', latic(1,1),' 1.000000' WRITE(input_unit_ctl2+i,'(A6,I5,A10 )',iostat = ios)'zdef ', Grd_CP(1)%nnVeg,' levels ' WRITE(input_unit_ctl2+i,'(10F10.2)')(depthcp(Grd_CP(1)%nnVeg-k+1),k=1,Grd_CP(1)%nnVeg) WRITE(date,'(I2.2,A1,I2.2,A3,I4.4)')idate(1),'Z',idate(3),clday(idate(2)),idate(4) deltat=DELTAOUT/60.0 WRITE(input_unit_ctl2+i,'(A6,A10,A10,A12,a,I10,A2)')'tdef ','1000000 ',' linear ',date,' ',deltat,'mn' WRITE(input_unit_ctl2+i,'(A6,I5 )',iostat = ios)'VARS ',Grd_CP(1)%nVars DO k=1,nVarscp IF(Grd_CP(k)%nLevs==1)THEN WRITE(input_unit_ctl2+i,'(A10,I5,A4,A,A2,A,A2)',iostat = ios)& Grd_CP(k)%NameG,Grd_CP(k)%nLevs-1,' 99 ',TRIM(Grd_CP(k)%Name),'[ ',TRIM(Grd_CP(k)%Units),' ]' ELSE WRITE(input_unit_ctl2+i,'(A10,I5,A4,A,A2,A,A2)',iostat = ios)& Grd_CP(k)%NameG,Grd_CP(k)%nLevs,' 99 ',TRIM(Grd_CP(k)%Name),'[ ',TRIM(Grd_CP(k)%Units),' ]' END IF END DO WRITE(input_unit_ctl2+i,'(A )',iostat = ios)'ENDVARS' CLOSE(input_unit_ctl2+i,STATUS='KEEP') END IF ELSE WRITE(0,*)"Unable to OPEN file";STOP END IF WRITE(namec,'(A19,I3.3)')'CANOPY_OUTPUTIBIS.S',i INQUIRE(IOLENGTH=lrec)dumpdata IF(OPENFILE_CP)OPEN(input_unit2+i,FILE='./outputdata/'//TRIM(namec)//'.bin',ACCESS='DIRECT',& FORM='UNFORMATTED',STATUS='UNKNOWN',ACTION='WRITE',RECL=lrec, & IOSTAT=open_status) IF( open_status == ok ) THEN DO j=1,jbMax DO k=1,nVarscp DO ll=1,nLevscp(k) NumberRecCP=NumberRecCP+1 WRITE(input_unit2+i,rec=NumberRecCP,iostat = ios)Grd_CP(k)%Buffer2(i,ll,j);IF(ios /= 0) STOP Grd_CP(k)%Buffer2(i,ll,j) =0.0_r8 END DO END DO ! WRITE(input_unit2+i,'(3I15,F15.4,51E15.5)',iostat = ios)& ! idatec(4),idatec(2),idatec(3),REAL(idatec(1))+((tod/3600.0_r8) - int(tod/3600.0_r8)),& ! Grd(1)%Buffer(i,1,j),Grd(2)%Buffer(i,1,j),Grd(3)%Buffer(i,1,j),& ! Grd(4)%Buffer(i,1,j),Grd(4)%Buffer(i,2,j),Grd(4)%Buffer(i,3,j),& ! Grd(4)%Buffer(i,4,j),Grd(4)%Buffer(i,5,j),Grd(4)%Buffer(i,6,j),& ! Grd(5)%Buffer(i,1,j),Grd(6)%Buffer(i,1,j),Grd(6)%Buffer(i,2,j),& ! Grd(6)%Buffer(i,3,j),Grd(6)%Buffer(i,4,j),Grd(6)%Buffer(i,5,j),Grd(6)%Buffer(i,6,j),& ! Grd(7)%Buffer(i,1,j),Grd(8)%Buffer(i,1,j),Grd(9)%Buffer(i,1,j),Grd(10)%Buffer(i,1,j),& ! Grd(11)%Buffer(i,1,j),Grd(12)%Buffer(i,1,j),Grd(13)%Buffer(i,1,j),Grd(14)%Buffer(i,1,j),& ! Grd(15)%Buffer(i,1,j),Grd(16)%Buffer(i,1,j),Grd(17)%Buffer(i,1,j),Grd(18)%Buffer(i,1,j),& ! Grd(19)%Buffer(i,1,j),Grd(20)%Buffer(i,1,j),Grd(21)%Buffer(i,1,j),Grd(22)%Buffer(i,1,j),& ! Grd(23)%Buffer(i,1,j),Grd(24)%Buffer(i,1,j),Grd(25)%Buffer(i,1,j),Grd(26)%Buffer(i,1,j),& ! Grd(27)%Buffer(i,1,j),Grd(28)%Buffer(i,1,j),Grd(29)%Buffer(i,1,j),Grd(30)%Buffer(i,1,j),& ! Grd(31)%Buffer(i,1,j),Grd(32)%Buffer(i,1,j),Grd(33)%Buffer(i,1,j),Grd(34)%Buffer(i,1,j),& ! Grd(35)%Buffer(i,1,j),Grd(36)%Buffer(i,1,j),Grd(37)%Buffer(i,1,j),Grd(38)%Buffer(i,1,j),& ! Grd(38)%Buffer(i,1,j),Grd(40)%Buffer(i,1,j),Grd(41)%Buffer(i,1,j) END DO ELSE WRITE(0,*)"Unable to OPEN file";STOP END IF END DO OPENFILE_CP=.FALSE. OPENFILE_CTL_CP=.FALSE. END IF END SUBROUTINE RunOutput1D_Grads2 SUBROUTINE RunOutput1D(jdt,tod,nband,dt,idate,idatec,idatep,DELTAOUT,latic,longc) IMPLICIT NONE REAL(KIND=r8), INTENT(IN ) :: tod INTEGER , INTENT(IN ) :: jdt INTEGER , INTENT(IN ) :: nband ! INTENT(IN ) :: nband REAL(KIND=r8), INTENT(IN ) :: dt ! INTENT(IN ) :: dt INTEGER , INTENT(IN ) :: idate (4) ! INTENT(IN ) :: idatec(:) INTEGER , INTENT(IN ) :: idatec(4) ! INTENT(IN ) :: idatec(:) INTEGER , INTENT(IN ) :: idatep(4) REAL(KIND=r8), INTENT(IN ) :: DELTAOUT REAL(KIND=r8), INTENT(IN ) :: latic(:,:) REAL(KIND=r8), INTENT(IN ) :: longc(:,:) REAL(KIND=r8) :: time INTEGER :: nCols INTEGER :: irec INTEGER :: reclen INTEGER :: open_status INTEGER :: ios INTEGER, PARAMETER :: input_unit=100 INTEGER, PARAMETER :: ok = 0 CHARACTER(LEN=255) :: PREFIX='OUTPUTIBIS' CHARACTER(LEN=255) :: SUFFIX='.bin' CHARACTER(LEN=255) :: namec CHARACTER(LEN=20) :: dump=' ' INTEGER :: k,i,j,ib nCols=ibMax time =tod open_status = ok IF(MOD(tod,DELTAOUT) == 0.0_r8 )THEN step=0 DO i=1,ibMax WRITE(namec,'(A16,I3.3)')'SAIDAMODELIBIS.S',i IF(OPENFILE)OPEN(input_unit+i,FILE='./outputdata/'//TRIM(namec),ACCESS='SEQUENTIAL',& FORM='FORMATTED',STATUS='UNKNOWN',ACTION='WRITE', & IOSTAT=open_status) IF( open_status == ok ) THEN IF(OPENFILE)WRITE(input_unit+i,'(55A15)',iostat = ios)& 'ano','mes','dia','hora',& Grd(1)%NameG,Grd(2)%NameG,Grd(3)%NameG,& Grd(4)%NameG,Grd(4)%NameG,Grd(4)%NameG,& Grd(4)%NameG,Grd(4)%NameG,Grd(4)%NameG,& Grd(5)%NameG,Grd(6)%NameG,Grd(6)%NameG,& Grd(6)%NameG,Grd(6)%NameG,Grd(6)%NameG,Grd(6)%NameG,& Grd(7)%NameG,Grd(8)%NameG,Grd(9)%NameG,Grd(10)%NameG,& Grd(11)%NameG,Grd(12)%NameG,Grd(13)%NameG,Grd(14)%NameG,& Grd(15)%NameG,Grd(16)%NameG,Grd(17)%NameG,Grd(18)%NameG,& Grd(19)%NameG,Grd(20)%NameG,Grd(21)%NameG,Grd(22)%NameG,& Grd(23)%NameG,Grd(24)%NameG,Grd(25)%NameG,Grd(26)%NameG,& Grd(27)%NameG,Grd(28)%NameG,Grd(29)%NameG,Grd(30)%NameG,& Grd(31)%NameG,Grd(32)%NameG,Grd(33)%NameG,Grd(34)%NameG,& Grd(35)%NameG,Grd(36)%NameG,Grd(37)%NameG,Grd(38)%NameG,& Grd(39)%NameG,Grd(40)%NameG,Grd(41)%NameG IF(OPENFILE)WRITE(input_unit+i,'(4A16,51A15)',iostat = ios)& dump,dump,dump,dump,& Grd(1)%Units,Grd(2)%Units,Grd(3)%Units,& Grd(4)%Units,Grd(4)%Units,Grd(4)%Units,& Grd(4)%Units,Grd(4)%Units,Grd(4)%Units,& Grd(5)%Units,Grd(6)%Units,Grd(6)%Units,& Grd(6)%Units,Grd(6)%Units,Grd(6)%Units,Grd(6)%Units,& Grd(7)%Units,Grd(8)%Units,Grd(9)%Units,Grd(10)%Units,& Grd(11)%Units,Grd(12)%Units,Grd(13)%Units,Grd(14)%Units,& Grd(15)%Units,Grd(16)%Units,Grd(17)%Units,Grd(18)%Units,& Grd(19)%Units,Grd(20)%Units,Grd(21)%Units,Grd(22)%Units,& Grd(23)%Units,Grd(24)%Units,Grd(25)%Units,Grd(26)%Units,& Grd(27)%Units,Grd(28)%Units,Grd(29)%Units,Grd(30)%Units,& Grd(31)%Units,Grd(32)%Units,Grd(33)%Units,Grd(34)%Units,& Grd(35)%Units,Grd(36)%Units,Grd(37)%Units,Grd(38)%Units,& Grd(39)%Units,Grd(40)%Units,Grd(41)%Units DO j=1,jbMax WRITE(input_unit+i,'(3I15,F15.4,51E15.5)',iostat = ios)& idatec(4),idatec(2),idatec(3),REAL(idatec(1))+((tod/3600.0_r8) - int(tod/3600.0_r8)),& Grd(1)%Buffer(i,1,j),Grd(2)%Buffer(i,1,j),Grd(3)%Buffer(i,1,j),& Grd(4)%Buffer(i,1,j),Grd(4)%Buffer(i,2,j),Grd(4)%Buffer(i,3,j),& Grd(4)%Buffer(i,4,j),Grd(4)%Buffer(i,5,j),Grd(4)%Buffer(i,6,j),& Grd(5)%Buffer(i,1,j),Grd(6)%Buffer(i,1,j),Grd(6)%Buffer(i,2,j),& Grd(6)%Buffer(i,3,j),Grd(6)%Buffer(i,4,j),Grd(6)%Buffer(i,5,j),Grd(6)%Buffer(i,6,j),& Grd(7)%Buffer(i,1,j),Grd(8)%Buffer(i,1,j),Grd(9)%Buffer(i,1,j),Grd(10)%Buffer(i,1,j),& Grd(11)%Buffer(i,1,j),Grd(12)%Buffer(i,1,j),Grd(13)%Buffer(i,1,j),Grd(14)%Buffer(i,1,j),& Grd(15)%Buffer(i,1,j),Grd(16)%Buffer(i,1,j),Grd(17)%Buffer(i,1,j),Grd(18)%Buffer(i,1,j),& Grd(19)%Buffer(i,1,j),Grd(20)%Buffer(i,1,j),Grd(21)%Buffer(i,1,j),Grd(22)%Buffer(i,1,j),& Grd(23)%Buffer(i,1,j),Grd(24)%Buffer(i,1,j),Grd(25)%Buffer(i,1,j),Grd(26)%Buffer(i,1,j),& Grd(27)%Buffer(i,1,j),Grd(28)%Buffer(i,1,j),Grd(29)%Buffer(i,1,j),Grd(30)%Buffer(i,1,j),& Grd(31)%Buffer(i,1,j),Grd(32)%Buffer(i,1,j),Grd(33)%Buffer(i,1,j),Grd(34)%Buffer(i,1,j),& Grd(35)%Buffer(i,1,j),Grd(36)%Buffer(i,1,j),Grd(37)%Buffer(i,1,j),Grd(38)%Buffer(i,1,j),& Grd(38)%Buffer(i,1,j),Grd(40)%Buffer(i,1,j),Grd(41)%Buffer(i,1,j) END DO IF(ios /= 0) STOP DO k=1,nVars DO ib=1,nLevs(k) Grd(k)%Buffer(:,ib,:) =0.0_r8 END DO END DO ELSE WRITE(0,*)"Unable to OPEN file";STOP END IF END DO OPENFILE=.FALSE. END IF END SUBROUTINE RunOutput1D SUBROUTINE RunOutput(jdt,tod,nband,dt,idate,idatec,idatep,DELTAOUT,latic,longc) IMPLICIT NONE REAL(KIND=r8), INTENT(IN ) :: tod INTEGER , INTENT(IN ) :: jdt INTEGER , INTENT(IN ) :: nband ! INTENT(IN ) :: nband REAL(KIND=r8), INTENT(IN ) :: dt ! INTENT(IN ) :: dt INTEGER , INTENT(IN ) :: idate (4) ! INTENT(IN ) :: idatec(:) INTEGER , INTENT(IN ) :: idatec(4) ! INTENT(IN ) :: idatec(:) INTEGER , INTENT(IN ) :: idatep(4) REAL(KIND=r8), INTENT(IN ) :: DELTAOUT REAL(KIND=r8), INTENT(IN ) :: latic(:,:) REAL(KIND=r8), INTENT(IN ) :: longc(:,:) REAL(KIND=r8) :: time INTEGER :: nCols INTEGER :: irec INTEGER :: reclen INTEGER :: open_status INTEGER :: ios INTEGER, PARAMETER :: input_unit=19 INTEGER, PARAMETER :: ok = 0 CHARACTER(LEN=255) :: PREFIX='OUTPUTIBIS' CHARACTER(LEN=255) :: SUFFIX='.bin' CHARACTER(LEN=255) :: namec INTEGER :: k,i nCols=ibMax time =tod IF(MOD(tod,DELTAOUT) == 0.0_r8 )THEN step=0 WRITE(namec,'(A10,2(I4.4,3i2.2),A4)')TRIM(PREFIX),& idate(4),idate(2),idate(3),idate(1),& idatec(4),idatec(2),idatec(3),idatec(1),& TRIM(SUFFIX) INQUIRE(IOLENGTH=reclen) Grd(1)%Buffer(:,1,:) OPEN(input_unit,FILE='./outputdata/'//TRIM(namec),ACCESS='DIRECT',& FORM='UNFORMATTED',STATUS='UNKNOWN',RECL=reclen,ACTION='WRITE', & IOSTAT=open_status) IF( open_status == ok ) THEN CALL Wrctls(namec,input_unit,longc,latic,idatec) irec=1 DO k=1,nVars DO i=1,nLevs(k) WRITE(input_unit,rec=irec,iostat = ios)Grd(k)%Buffer(:,i,:);IF(ios /= 0) STOP !WRITE(0,*)'latic',MAXVAL(Grd(k)%Buffer(:,i,:)),MINVAL(Grd(k)%Buffer(:,i,:)) irec=irec+1 Grd(k)%Buffer(:,i,:) =0.0_r8 END DO END DO CLOSE(input_unit,STATUS='KEEP') ELSE WRITE(0,*)"Unable to OPEN file";STOP END IF END IF END SUBROUTINE RunOutput SUBROUTINE Wrctls(namec,input_unit,longc,latic,idatec) IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN ) :: namec INTEGER, INTENT(IN ) :: input_unit REAL(KIND=r8), INTENT(IN ) :: longc(:,:) REAL(KIND=r8), INTENT(IN ) :: latic(:,:) INTEGER , INTENT(IN ) :: idatec(4) ! INTENT(IN ) :: idatec(:) INTEGER :: open_status INTEGER, PARAMETER :: ok = 0 CHARACTER(LEN=12) :: date CHARACTER(LEN=3) :: clday(12)=(/'JAN','FEB','MAR','APR','MAY','JUN',& 'JUL','AUG','SEP','OCT','NOV','DEC'/) INTEGER :: lch,i,j,k lch=LEN_TRIM(TRIM(namec))-4 OPEN(input_unit+1,FILE='./outputdata/'//namec(1:lch)//'.ctl',FORM='FORMATTED',& ACTION='WRITE',STATUS='UNKNOWN',IOSTAT=open_status) IF( open_status == ok ) THEN WRITE(input_unit+1,'(A6,A)')'dset ^',TRIM(namec) WRITE(input_unit+1,'(A8,A6,A12)')'options ',' yrev ',' big_endian ' WRITE(input_unit+1,'(A6,e12.5)')'undef ',undef WRITE(input_unit+1,'(A6,A)')'title ','CPTEC-IBIS PROJECT' WRITE(input_unit+1,'(A6,I5,A10)')'xdef ',Grd(1)%ibMax,' levels ' WRITE(input_unit+1,'(10F12.5)')(longc(i,1),i=1,Grd(1)%ibMax) WRITE(input_unit+1,'(A6,I5,A10)')'ydef ',Grd(1)%jbMax,' levels ' WRITE(input_unit+1,'(10F12.5)')(latic(1,j),j=1,Grd(1)%jbMax) WRITE(input_unit+1,'(A6,I5,A10)')'zdef ', Grd(1)%nSoil,' levels ' WRITE(input_unit+1,'(10I10)')(i,i=1,Grd(1)%nSoil) WRITE(date,'(I2.2,A1,I2.2,A3,I4.4)')idatec(1),'Z',idatec(3),clday(idatec(2)),idatec(4) WRITE(input_unit+1,'(A6,A5,A10,A12,A6)')'tdef ',' 1 ',' linear ',date,' 6hr ' WRITE(input_unit+1,'(A6,I5)')'vars ', Grd(1)%nVars DO k=1,Grd(1)%nVars WRITE(input_unit+1,'(A10,I5,A4,A,A2,A,A2)')& Grd(k)%NameG,Grd(k)%nLevs,' 99 ',TRIM(Grd(k)%Name),'[ ',TRIM(Grd(k)%Units),' ]' END DO WRITE(input_unit+1,'(A7)')'endvars' ELSE WRITE(0,*)"Unable to OPEN file";STOP END IF CLOSE(input_unit+1,STATUS='KEEP') END SUBROUTINE Wrctls SUBROUTINE NULLIFING(a,nLevs) IMPLICIT NONE TYPE(GRADS) :: a INTEGER, INTENT(IN ) :: nLevs IF ( ASSOCIATED( a%Buffer) ) NULLIFY ( a%Buffer ) ALLOCATE( a%Buffer(ibMax,nLevs,jbMax) ) a%Buffer=0.0_r8 END SUBROUTINE NULLIFING SUBROUTINE NULLIFING2(a,nLevs) IMPLICIT NONE TYPE(GRADS2) :: a INTEGER, INTENT(IN ) :: nLevs IF ( ASSOCIATED( a%Buffer2) ) NULLIFY ( a%Buffer2) ALLOCATE( a%Buffer2(ibMax,nLevs,jbMax) ) a%Buffer2=0.0_r8 END SUBROUTINE NULLIFING2 END MODULE IbisOutput