!!---------------------------------------------------------------------- !! *** diawri_dimg.h90 *** !!---------------------------------------------------------------------- !! OPA 9.0 , LODYC-IPSL (2003) !!---------------------------------------------------------------------- SUBROUTINE dia_wri (kt, kindic) !!---------------------------------------------------------------------- !! *** routine dia_wri *** !! !! ** Purpose : output dynamics and tracer fields on direct access file !! suitable for MPP computing !! !! ** define key : 'key_dimgout' !! !! ** Method : Default is to cumulate the values over the interval between !! 2 output, and each nwrite time-steps the mean value is computed !! and written to the direct access file. !! If 'key_diainstant' is defined, no mean values are computed and the !! instantaneous fields are dump. !! kindic is 0 or >0 in normal condition. When < 0 it indicates an error !! condition and instantaneous file output is forced. !! Each processor creates its own file with its local data !! Merging all the files is performed off line by a dedicated program !! !! ** Arguments : !! kt : time-step number !! kindinc : error condition indicator : >=0 : OK, < 0 : error. !! !! ** Naming convention for files !! !! {cexper}_{var}_y----m--d--.dimg !! cexper is the name of the experience, given in the namelist !! var can be either U, V, T, S, KZ, SSH, ... !! var can also be 2D, which means that each level of the file is a 2D field as described below !! y----m--d-- is the date at the time of the dump !! For mpp output, each processor dumps its own memory, on appropriate record range !! (direct access : for level jk of a klev field on proc narea irec = 1+ klev*(narea -1) + jk ) !! To be tested with a lot of procs !!!! !! !! level 1: taux(:,:) * umask(:,:,1) zonal stress in N.m-2 !! level 2: tauy(:,:) * vmask(:,:,1) meridional stress in N. m-2 !! level 3: q (:,:) + qsr(:,:) total heat flux (W/m2) !! level 4: emp (:,:) E-P flux (mm/day) !! level 5: tb (:,:,1)-sst model SST -forcing sst (degree C) !! level 6: bsfb(:,:) streamfunction (m**3/s) !! level 7: qsr (:,:) solar flux (W/m2) !! level 8: qrp (:,:) relax component of T flux. !! level 9: erp (:,:) relax component of S flux !! level 10: hmld(:,:) turbocline depth !! level 11: hmlp(:,:) mixed layer depth !! level 12: freeze (:,:) Ice cover (1. or 0.) !! level 13: sst(:,:) the observed SST we relax to. !! level 14: qct(:,:) equivalent flux due to treshold SST !! level 15: fbt(:,:) feedback term . !! level 16: gps(:,:) the surface pressure (m). !! level 17: spgu(:,:) the surface pressure gradient in X direction. !! level 18: spgv(:,:) the surface pressure gradient in Y direction. !! !! History !! original : 91-03 () !! additions : 91-11 (G. Madec) !! additions : 92-06 (M. Imbard) correction restart file !! additions : 92-07 (M. Imbard) split into diawri and rstwri !! additions : 93-03 (M. Imbard) suppress writibm !! additions : 94-12 (M. Imbard) acces direct files !! additions : 97-2002 ( Clipper Group ) dimg files !! dec 2003 ( J.M. Molines) f90, mpp output for OPA9.0 !!---------------------------------------------------------------------- !! * modules used USE lib_mpp USE dtasst, ONLY : sst !! * Arguments INTEGER ,INTENT(in) :: kt, kindic !! * local declarations INTEGER :: inbsel !! INTEGER :: iwrite INTEGER :: iyear,imon,iday #if defined key_diainstant REAL(wp),DIMENSION(jpi,jpj,jpk) :: fsel LOGICAL, PARAMETER :: l_dia_inst=.true. REAL(wp), SAVE, DIMENSION (1,1,1) :: um , vm ! dummy arrays for comiplation purpose REAL(wp), SAVE, DIMENSION (1,1,1) :: tm , sm ! REAL(wp), SAVE, DIMENSION (1,1,1) :: fsel ! REAL(wp) :: zdtj #else INTEGER, SAVE :: nmoyct REAL(wp), SAVE, DIMENSION (jpi,jpj,jpk) :: um , vm ! used to compute mean u, v fields REAL(wp), SAVE, DIMENSION (jpi,jpj,jpk) :: tm , sm ! used to compute mean t, s fields REAL(wp), SAVE, DIMENSION (jpi,jpj,jpk) :: fsel ! used to compute mean 2d fields REAL(wp) :: zdtj LOGICAL, PARAMETER :: l_dia_inst=.false. #endif ! CHARACTER(LEN=80) :: clname CHARACTER(LEN=80) :: cltext CHARACTER(LEN=80) :: clmode CHARACTER(LEN= 4) :: clver ! ! Initialization ! --------------- ! #ifdef key_diaspr inbsel = 18 #else inbsel = 15 #endif IF (inbsel > jpk) THEN IF (lwp) WRITE(numout,*) & ' STOP inbsel =',inbsel,' is larger than jpk=',jpk STOP END IF iyear = ndastp/10000 imon = (ndastp-iyear*10000)/100 iday = ndastp - imon*100 - iyear*10000 ! !! dimg format V1.0 should start with the 4 char. string '@!01' !! clver='@!01' ! IF ( .NOT. l_dia_inst ) THEN !#if ! defined key_diainstant ! !! * Mean output section !! ---------------------- ! IF (kt == nit000 .AND. lwp ) WRITE(numout,*) & 'THE OUTPUT FILES CONTAINS THE AVERAGE OF EACH FIELD' ! IF ( kt == nit000 .AND. kindic > 0 ) THEN ! reset arrays for average computation nmoyct = 0 ! um(:,:,:) = 0._wp vm(:,:,:) = 0._wp tm(:,:,:) = 0._wp sm(:,:,:) = 0._wp fsel(:,:,:) = 0._wp ! END IF ! cumulate values ! --------------- nmoyct = nmoyct+1 ! um(:,:,:)=um(:,:,:) + un (:,:,:) vm(:,:,:)=vm(:,:,:) + vn (:,:,:) tm(:,:,:)=tm(:,:,:) + tn (:,:,:) sm(:,:,:)=sm(:,:,:) + sn (:,:,:) ! fsel(:,:,1 ) = fsel(:,:,1 ) + taux(:,:) * umask(:,:,1) fsel(:,:,2 ) = fsel(:,:,2 ) + tauy(:,:) * vmask(:,:,1) fsel(:,:,3 ) = fsel(:,:,3 ) + q (:,:) + qsr(:,:) fsel(:,:,4 ) = fsel(:,:,4 ) + emp (:,:) fsel(:,:,5 ) = fsel(:,:,5 ) + tb (:,:,1) - sst(:,:) #if defined key_dynspg_fsc fsel(:,:,6 ) = fsel(:,:,6 ) + sshn(:,:) ! SSH #else fsel(:,:,6 ) = fsel(:,:,6 ) + bsfn(:,:) ! BSF #endif fsel(:,:,7 ) = fsel(:,:,7 ) + qsr(:,:) fsel(:,:,8 ) = fsel(:,:,8 ) + qrp (:,:) fsel(:,:,9 ) = fsel(:,:,9 ) + erp (:,:) fsel(:,:,10) = fsel(:,:,10) + hmld(:,:) fsel(:,:,11) = fsel(:,:,11) + hmlp(:,:) fsel(:,:,12) = fsel(:,:,12) + freeze(:,:) fsel(:,:,13) = fsel(:,:,13) + sst(:,:) ! fsel(:,:,14) = fsel(:,:,14) + qct(:,:) ! fsel(:,:,15) = fsel(:,:,15) + fbt(:,:) #ifdef key_diaspr fsel(:,:,16) = fsel(:,:,16) + gps(:,:)/g #endif ! ! Output of dynamics and tracer fields and selected fields (numwri) ! ----------------------------------------------------------------- ! ! zdtj=rdt/86400. ! time step in days WRITE(clmode,'(f5.1,a)' ) nwrite*zdtj,' days average' ! iwrite=NINT(adatrj/rwrite) ! IF (abs(adatrj-iwrite*rwrite) < zdtj/2. & IF ( ( MOD (kt,nwrite) == 0 ) & & .OR. kindic < 0 & & .OR. ( kt == 1 .AND. kindic > 0) ) THEN ! it is time to make a dump on file ! compute average um(:,:,:) = um(:,:,:) / nmoyct vm(:,:,:) = vm(:,:,:) / nmoyct tm(:,:,:) = tm(:,:,:) / nmoyct sm(:,:,:) = sm(:,:,:) / nmoyct ! fsel(:,:,:) = fsel(:,:,:) / nmoyct ! ! note : the surface pressure is not averaged, but rather ! computed from the averaged gradients. ! #ifdef key_diaspr fsel(:,:,16)= gps(:,:)/g fsel(:,:,17)= spgu(:,:) fsel(:,:,18)= spgv(:,:) #endif ENDIF ! ELSE ! l_dia_inst true !# else ! !! * Instantaneous output section !! ------------------------------ ! IF (kt == nit000 .AND. lwp ) WRITE(numout,*) & 'THE OUTPUT FILES CONTAINS INSTANTANEOUS VALUES OF EACH FIELD' ! zdtj=rdt/86400. ! time step in days ! iwrite=NINT(adatrj/rwrite) clmode='instantaneous' ! IF (abs(adatrj-iwrite*rwrite) < zdtj/2. & IF ( ( MOD (kt,nwrite) == 0 ) & & .OR. kindic < 0 & & .OR. ( kt == 1 .AND. kindic > 0) ) THEN ! ! transfer wp arrays to sp arrays for dimg files fsel(:,:,:) = 0._wp ! fsel(:,:,1 ) = taux(:,:) * umask(:,:,1) fsel(:,:,2 ) = tauy(:,:) * vmask(:,:,1) fsel(:,:,3 ) = q (:,:) + qsr(:,:) fsel(:,:,4 ) = emp (:,:) fsel(:,:,5 ) = (tb (:,:,1) -sst(:,:)) *tmask(:,:,1) #if defined key_dynspg_fsc fsel(:,:,6 ) = sshn(:,:) #else fsel(:,:,6 ) = bsfn(:,:) #endif fsel(:,:,7 ) = qsr (:,:) fsel(:,:,8 ) = qrp (:,:) fsel(:,:,9 ) = erp (:,:)*tmask(:,:,1) fsel(:,:,10) = hmld(:,:) fsel(:,:,11) = hmlp(:,:) fsel(:,:,12) = freeze(:,:) fsel(:,:,13) = sst(:,:) ! fsel(:,:,14) = qct(:,:) ! fsel(:,:,15) = fbt(:,:) #ifdef key_diaspr fsel(:,:,16) = gps(:,:) /g fsel(:,:,17) = spgu(:,:) fsel(:,:,18) = spgv(:,:) #endif ! ! qct(:,:) = 0._wp ENDIF !#endif ENDIF ! ! Opening of the datrj.out file with the absolute time in day of each dump ! this file gives a record of the dump date for post processing ( ASCII file ) ! IF ( ( MOD (kt,nwrite) == 0 ) & & .OR. kindic < 0 & & .OR. ( kt == 1 .AND. kindic > 0) ) THEN OPEN (14,FILE='datrj.out',FORM='FORMATTED', STATUS='UNKNOWN',POSITION='APPEND ') IF (lwp) WRITE(14,'(f10.4,1x,i8)') adatrj, ndastp CLOSE(14) IF (lwp) WRITE(numout,*)'Days since the begining of the run :',adatrj !! * U section WRITE(clname,9000) TRIM(cexper),'U',iyear,imon,iday cltext=TRIM(cexper)//' U(m/s) '//TRIM(clmode) IF ( kindic < 0 ) cltext=TRIM(cexper)//' U(m/s) instantaneous (explosion)' ! IF ( l_dia_inst) THEN CALL dia_wri_dimg(clname, cltext, un, jpk, 'T') ELSE IF ( kindic == -3 ) THEN ! ... in case of explosion on umax, dump instantateous u field instead of mean. CALL dia_wri_dimg(clname, cltext, un, jpk, 'T') ELSE CALL dia_wri_dimg(clname, cltext, um, jpk, 'T') END IF ENDIF !! * V section WRITE(clname,9000) TRIM(cexper),'V',iyear,imon,iday cltext=TRIM(cexper)//' V(m/s) '//TRIM(clmode) ! IF ( l_dia_inst) THEN CALL dia_wri_dimg(clname, cltext, vn, jpk, 'T') ELSE CALL dia_wri_dimg(clname, cltext, vm, jpk, 'T') END IF ! !! * KZ section WRITE(clname,9000) TRIM(cexper),'KZ',iyear,imon,iday cltext=TRIM(cexper)//' KZ(m2/s) instantaneous' ! no average on kz (convective area may show up too strongly ) CALL dia_wri_dimg(clname, cltext, avt, jpk, 'W') ! !! * T section WRITE(clname,9000) TRIM(cexper),'T',iyear,imon,iday cltext=TRIM(cexper)//' T (DegC) '//TRIM(clmode) IF (l_dia_inst) THEN CALL dia_wri_dimg(clname, cltext, tn, jpk, 'T') ELSE CALL dia_wri_dimg(clname, cltext, tm, jpk, 'T') END IF ! !! * S section WRITE(clname,9000) TRIM(cexper),'S',iyear,imon,iday cltext=TRIM(cexper)//' S (PSU) '//TRIM(clmode) IF (l_dia_inst) THEN CALL dia_wri_dimg(clname, cltext, sn, jpk, 'T') ELSE CALL dia_wri_dimg(clname, cltext, sm, jpk, 'T') END IF ! !! * 2D section WRITE(clname,9000) TRIM(cexper),'2D',iyear,imon,iday cltext='2D fields '//TRIM(clmode) IF (l_dia_inst) THEN CALL dia_wri_dimg(clname, cltext, fsel, inbsel, '2') ELSE CALL dia_wri_dimg(clname, cltext, fsel, inbsel, '2') ENDIF IF( lk_mpp ) CALL mppsync ! synchronization in mpp !! * Log message in numout IF(lwp)WRITE(numout,*) ' ' IF(lwp)WRITE(numout,*) ' **** WRITE in numwri ',kt IF(lwp .AND. l_dia_inst) WRITE(numout,*) ' instantaneous fields' IF(lwp .AND. .NOT. l_dia_inst ) WRITE(numout,*) ' average fields with ',nmoyct,'pdt' ! ! !! * Reset cumulating arrays and counter to 0 after writing ! IF ( .NOT. l_dia_inst ) THEN nmoyct = 0 ! um(:,:,:) = 0._wp vm(:,:,:) = 0._wp tm(:,:,:) = 0._wp sm(:,:,:) = 0._wp fsel(:,:,:) = 0._wp ENDIF END IF ! 9000 FORMAT(a,"_",a,"_y",i4.4,"m",i2.2,"d",i2.2,".dimgproc") END SUBROUTINE dia_wri SUBROUTINE dia_wri_state ( cdfile_name) !!------------------------------------------------------------------- !! *** ROUTINE dia_wri_state *** !! !! ** Purpose : Dummy routine for compatibility with IOIPSL output !! !! ** History : !! 9.O ! 03-06 (J.M. Molines ) dimgout !!-------------------------------------------------------------------- !! * Arguments CHARACTER (len=*), INTENT(in) :: cdfile_name ! name of the file created !!-------------------------------------------------------------------- IF (lwp) WRITE(numout,*) 'dia_wri_state: Dummy call', cdfile_name IF (lwp) WRITE(numout,*) '-------------' IF (lwp) WRITE(numout,*) END SUBROUTINE dia_wri_state SUBROUTINE dia_wri_dimg(cd_name, cd_text, ptab, klev, cd_type ) !!------------------------------------------------------------------------- !! *** ROUTINE dia_wri_dimg *** !! !! ** Purpose : write ptab in the dimg file cd_name, with comment cd_text. !! ptab has klev x 2D fields !! !! ** Action : !! Define header variables from the config parameters !! Open the dimg file on unit inum = 14 ( IEEE I4R4 file ) !! Write header on record 1 !! Write ptab on the following klev records !! !! History : !! 03-12 (J.M. Molines ) : Original. Replace ctlopn, writn2d !!--------------------------------------------------------------------------- !! * subsitutions # include "domzgr_substitute.h90" !! * Arguments CHARACTER(len=*),INTENT(in) :: & & cd_name, & ! dimg file name & cd_text ! comment to write on record #1 INTEGER, INTENT(in) :: klev ! number of level in ptab to write REAL(wp),INTENT(in), DIMENSION(:,:,:) :: ptab ! 3D array to write CHARACTER(LEN=1),INTENT(in) :: cd_type ! either 'T', 'W' or '2' , depending on the vertical ! ! grid for ptab. 2 stands for 2D file !! * Local declarations INTEGER :: jk, jn ! dummy loop indices INTEGER :: irecl4, & ! record length in bytes & inum, & ! logical unit (set to 14) & irec ! current record to be written REAL(sp) :: zdx,zdy,zspval,zwest,ztimm REAL(sp) :: zsouth REAL(sp),DIMENSION(jpi,jpj) :: z42d ! 2d temporary workspace (sp) REAL(sp),DIMENSION(jpk) :: z4dep ! vertical level (sp) CHARACTER(LEN=4) :: clver='@!01' !!--------------------------------------------------------------------------- !! * Initialisations irecl4 = jpi*jpj*sp inum = 14 zspval=0.0_sp ! special values on land ! the 'numerical' grid is described. The geographical one is in a grid file zdx=1._sp zdy=1._sp zsouth=njmpp * 1._sp zwest=nimpp * 1._sp ! time in days since the historical begining of the run (nit000 = 0 ) ztimm=adatrj SELECT CASE ( cd_type ) CASE ( 'T') z4dep(:)=fsdept(1,1,:) CASE ( 'W' ) z4dep(:)=fsdepw(1,1,:) CASE ( '2' ) z4dep(1:klev) =(/(jk, jk=1,klev)/) CASE DEFAULT IF(lwp) WRITE(numout,*) ' E R R O R : bad cd_type in dia_wri_dimg ' STOP 'dia_wri_dimg' END SELECT !! * Open file OPEN (inum, FILE=cd_name, FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl4 ) !! * Write header on record #1 IF(lwp) WRITE(inum,REC=1 ) clver, cd_text, irecl4, & & jpi,jpj, klev*jpnij, 1 , 1 , & & zwest, zsouth, zdx, zdy, zspval, & & (z4dep(1:klev),jn=1,jpnij), & & ztimm, & & narea, jpnij,jpiglo,jpjglo, & ! extension to dimg for mpp output & nlcit,nlcjt, nldit, nldjt, nleit, nlejt, nimppt, njmppt ! !! * Write klev levels DO jk = 1, klev irec =1 + klev * (narea -1) + jk z42d(:,:) = ptab(:,:,jk) WRITE(inum,REC=irec) z42d(:,:) END DO !! * Close the file CLOSE(inum) END SUBROUTINE dia_wri_dimg