!!--------------------------------------------------------------------- !! diawri_fdir.h90 !! ******************* !!--------------------------------------------------------------------- !! dia_wri : create the standart direct access output files !!--------------------------------------------------------------------- SUBROUTINE dia_wri ( kt, kindic ) !!--------------------------------------------------------------------- !! *** ROUTINE diawri *** !! !! ** Purpose : Standard output of opa: dynamics and tracer fields !! in direct access format !! !! ** Method : At the first time step (nit000), output of the grid- !! point position and depth and of the mask at t-point. !! Each nwrite time step, output of velocity fields (un,vn,wn) !! tracer fields (tn,sn) and three two dimensional selected fields, !! usually the thermohaline forcing fields (q, e, qsr). !! If kindic <0, output of fields before the model interruption. !! If kindic =0, time step loop !! If kindic >0, output of fields before the time step loop !! !! History : !! ! 91-03 () Original code !! ! 91-11 (G. Madec) !! ! 92-06 (M. Imbard) correction restart file !! ! 92-07 (M. Imbard) split into diawri and rstwri !! ! 93-03 (M. Imbard) suppress writibm !! ! 94-12 (M. Imbard) access direct format !! 8.5 ! 02-09 (G. Madec) F90: Free form and module !!---------------------------------------------------------------------- !! * Arguments INTEGER, INTENT( in ) :: kt ! ocean time-step index INTEGER, INTENT( in ) :: kindic ! !! * Save variables INTEGER, SAVE :: & nmoyct, & ! time-step counter for averaging nstepo ! output number # if ! defined key_diainstant REAL(wp), SAVE, DIMENSION(jpi,jpj,jpk) :: & um, vm, wm, & ! average value of velocity components tm, sm, & ! average value of temperature and salinity am, & ! average value of vert.diffusivity coef. fsel ! average value of 2D fields collected in a 2D one # endif !! * Local declarations INTEGER :: inum = 11 ! temporary logical unit INTEGER :: inbrec, inbsel INTEGER :: jk, jc INTEGER :: ilglo, ibloc, ierror, ic REAL(wp) :: zmoyctr #if defined key_diainstant REAL(wp), DIMENSION(jpi,jpj,jpk) :: & zsel ! temporary array for 2D fields collected in a 3D one #endif CHARACTER (len=40) :: clhstnam CHARACTER (len=21) :: cldir, clunf, clunk CHARACTER (len=80) :: classign !!---------------------------------------------------------------------- ! 1. Initialization ! ----------------- inbrec = 7 inbsel = 13 IF( kt == nit000 .AND. kindic > 0 ) THEN ! 0.1 Open specifier clunk = 'UNKNOWN' clunf = 'UNFORMATTED' cldir = 'DIRECT' ! computation of the record length for direct access file ! this length depend of 512 for the t3d machine ibloc = 4096 ilglo = ibloc*( (jpiglo*jpjglo*jpbytda-1 )/ibloc+1) CALL dia_nam(clhstnam,nwrite,' ') DO jc=1,40 IF( clhstnam(jc:jc) == ' ' ) go to 120 END DO 120 CONTINUE ic=jc clhstnam=clhstnam(1:ic-1)//".fd" CALL ctlopn( inum, 'date.file', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', 1, numout, lwp, 1 ) WRITE(inum,*) clhstnam CLOSE(inum) WRITE (UNIT = classign,FMT ='(''assign -F null -N ieee f:'',a40)') clhstnam IF(lwp) WRITE(numout,*) classign #if defined _CRAY CALL ASSIGN(classign, ierror) #endif IF(lwp)WRITE(numout,*) ' ierror assign = ',ierror CALL ctlopn( numwri, clhstnam, clunk, clunf, cldir, & ilglo, numout, lwp, 1 ) ENDIF #if ! defined key_diainstant IF( kt == nit000 .AND. kindic > 0 ) THEN ! 1.1.1 Prognostic variables nmoyct = 0 nstepo = 0 um(:,:,:) = 0.e0 vm(:,:,:) = 0.e0 wm(:,:,:) = 0.e0 tm(:,:,:) = 0.e0 sm(:,:,:) = 0.e0 am(:,:,:) = 0.e0 fsel(:,:,:) = 0.e0 ENDIF ! 1.2 Sum nmoyct = nmoyct+1 um(:,:,:) = um (:,:,:) + un(:,:,:) vm(:,:,:) = vm (:,:,:) + vn(:,:,:) wm(:,:,:) = wm (:,:,:) + wn(:,:,:) tm(:,:,:) = tm (:,:,:) + tn(:,:,:) sm(:,:,:) = sm (:,:,:) + sn(:,:,:) am(:,:,:) = am (:,:,:) +avt(:,:,:) fsel(:,:,1 ) = fsel(:,:,1 ) + taux(:,:) fsel(:,:,2 ) = fsel(:,:,2 ) + tauy(:,:) fsel(:,:,3 ) = fsel(:,:,3 ) + qt (:,:) fsel(:,:,4 ) = fsel(:,:,4 ) + (emp(:,:) - runoff(:,:))*rday #if defined key_dtasst fsel(:,:,5 ) = fsel(:,:,5 ) + sst (:,:) #else fsel(:,:,5 ) = fsel(:,:,5 ) + tb (:,:,1) #endif fsel(:,:,6 ) = fsel(:,:,6 ) + qsr (:,:) #if defined key_dynspg_fsc fsel(:,:,7 ) = fsel(:,:,7 ) + sshn(:,:) #else fsel(:,:,7 ) = fsel(:,:,7 ) + bsfn(:,:) #endif fsel(:,:,8 ) = fsel(:,:,8 ) + freeze(:,:) fsel(:,:,9 ) = fsel(:,:,9 ) + qrp (:,:) fsel(:,:,10) = fsel(:,:,10) + erp (:,:)*rday fsel(:,:,11) = fsel(:,:,11) + hmlp(:,:) fsel(:,:,12) = fsel(:,:,12) + emp (:,:)*rday*sb(:,:,1) fsel(:,:,13) = fsel(:,:,13) + erp (:,:)*rday*sb(:,:,1) fsel(:,:,14) = fsel(:,:,14) + hmld(:,:) fsel(:,:,15) = 0.e0 fsel(:,:,16) = fsel(:,:,16) + runoff(:,:) ! vertical sum of intantaneous in situ density anomaly fsel(:,:,17) = 0. DO jk =1, jpk fsel(:,:,17) = fsel(:,:,17) + rhd(:,:,jk) * e1t(:,:) * e2t(:,:) * fse3t(:,:,jk) END DO ! 1.2 Output of the model domain (at nit000) IF( kt == nit000 .AND. kindic > 0 ) THEN IF(lwp) WRITE ( numwri, REC=1 ) jpiglo, jpjglo, jpk ENDIF ! 2. Output of dynamics and tracer fields and selected fields (numwri) ! ----------------------------------------------------------- ! 2.1 Average IF( MOD( kt, nwrite ) == 0 .OR. kindic < 0 .OR. & ( kt == nit000 .AND. kindic > 0) .OR. kt == nitend ) THEN IF(kindic /= -3) THEN zmoyctr = 1. / FLOAT(nmoyct) um (:,:,:) = um (:,:,:) * zmoyctr vm (:,:,:) = vm (:,:,:) * zmoyctr wm (:,:,:) = wm (:,:,:) * zmoyctr tm (:,:,:) = tm (:,:,:) * zmoyctr sm (:,:,:) = sm (:,:,:) * zmoyctr am (:,:,:) = am (:,:,:) * zmoyctr fsel(:,:,:) = fsel(:,:,:) * zmoyctr ELSE ! kindic=-3 STOP with e r r o r, instantaneous output nmoyct = 1 um(:,:,:) = un (:,:,:) vm(:,:,:) = vn (:,:,:) wm(:,:,:) = wn (:,:,:) tm(:,:,:) = tn (:,:,:) sm(:,:,:) = sn (:,:,:) am(:,:,:) = avt(:,:,:) fsel(:,:,1 ) = taux(:,:) fsel(:,:,2 ) = tauy(:,:) fsel(:,:,3 ) = qt (:,:) fsel(:,:,4 ) = (emp (:,:)- runoff(:,:))*rday #if defined key_dtasst fsel(:,:,5 ) = sst (:,:) #else fsel(:,:,5 ) = tb (:,:,1) #endif fsel(:,:,6 ) = qsr (:,:) #if defined key_dynspg_fsc fsel(:,:,7 ) = sshn(:,:) #else fsel(:,:,7 ) = bsfn(:,:) #endif fsel(:,:,8 ) = freeze(:,:) fsel(:,:,9 ) = qrp (:,:) fsel(:,:,10) = erp (:,:) fsel(:,:,11) = hmlp(:,:) fsel(:,:,12) = emp (:,:)*rday*sb(:,:,1) fsel(:,:,13) = erp (:,:)*rday*sb(:,:,1) fsel(:,:,14) = hmld(:,:) fsel(:,:,15) = 0.e0 fsel(:,:,16) = runoff(:,:) ENDIF ! 2.2 Write IF(lwp) THEN um(3,1,1) = FLOAT( kt ) vm(3,1,1) = FLOAT( nmoyct ) ENDIF CALL write4( numwri, um , nstepo*inbrec+2 ) CALL write4( numwri, vm , nstepo*inbrec+3 ) CALL write4( numwri, wm , nstepo*inbrec+4 ) CALL write4( numwri, tm , nstepo*inbrec+5 ) CALL write4( numwri, sm , nstepo*inbrec+6 ) CALL write4( numwri, am , nstepo*inbrec+7 ) CALL write4( numwri, fsel, nstepo*inbrec+8 ) IF(lwp) WRITE(numout,*) ' ' IF(lwp) WRITE(numout,*) ' **** write in numwri ',kt IF(lwp) WRITE(numout,*) ' average fields with ',nmoyct,'pdt' ! 2.3 Zero initialisation nmoyct = 0 nstepo = nstepo+1 um(:,:,:) = 0.e0 vm(:,:,:) = 0.e0 wm(:,:,:) = 0.e0 tm(:,:,:) = 0.e0 sm(:,:,:) = 0.e0 am(:,:,:) = 0.e0 fsel(:,:,:) = 0.e0 ENDIF #else ! Sortie instantanee IF( kt == nit000 .AND. kindic > 0 ) THEN nstepo = 0 IF(lwp) WRITE ( numwri, REC=1 ) jpiglo, jpjglo, jpk ENDIF IF( MOD( kt, nwrite ) == 0 .OR. kindic < 0 & .OR. (kt == nit000 .AND. kindic > 0) .OR. kt == nitend ) THEN fsel(:,:,:) = 0.e0 zsel(:,:,1 ) = taux(:,:) * umask(:,:,1) zsel(:,:,2 ) = tauy(:,:) * vmask(:,:,1) zsel(:,:,3 ) = qt (:,:) zsel(:,:,4 ) = (emp (:,:)-runoff(:,:))*rday #if defined key_dtasst zsel(:,:,5 ) = sst (:,:) #else zsel(:,:,5 ) = tb (:,:,1) #endif zsel(:,:,6 ) = qsr (:,:) #if defined key_dynspg_fsc zsel(:,:,7 ) = sshn(:,:) #else zsel(:,:,7 ) = bsfn(:,:) #endif zsel(:,:,8 ) = freeze(:,:) zsel(:,:,9 ) = qrp (:,:) zsel(:,:,10) = erp (:,:) zsel(:,:,11) = hmlp(:,:) zsel(:,:,12) = emp (:,:) * sb(:,:,1) zsel(:,:,13) = erp (:,:) * sb(:,:,1) zsel(:,:,14) = hmld(:,:) zsel(:,:,15) = 0.e0 zsel(:,:,16) = runoff(:,:) CALL write4( numwri, un , nstepo*inbrec+2 ) CALL write4( numwri, vn , nstepo*inbrec+3 ) CALL write4( numwri, wn , nstepo*inbrec+4 ) CALL write4( numwri, tn , nstepo*inbrec+5 ) CALL write4( numwri, sn , nstepo*inbrec+6 ) CALL write4( numwri, avt , nstepo*inbrec+7 ) CALL write4( numwri, zsel, nstepo*inbrec+8 ) IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*) ' **** write in numwri ',kt IF(lwp) WRITE(numout,*) ' instantaneous fields' nstepo = nstepo+1 ENDIF END SUBROUTINE dia_wri