New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
diawri_dimg.h90 in trunk/NEMO/OPA_SRC/DIA – NEMO

source: trunk/NEMO/OPA_SRC/DIA/diawri_dimg.h90 @ 699

Last change on this file since 699 was 699, checked in by smasson, 17 years ago

insert revision Id

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 15.6 KB
RevLine 
[3]1  !!----------------------------------------------------------------------
[32]2  !!                        ***  diawri_dimg.h90  ***
[3]3  !!----------------------------------------------------------------------
[247]4  !!   OPA 9.0 , LOCEAN-IPSL (2005)
[699]5  !! $Id$
[405]6  !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
[3]7  !!----------------------------------------------------------------------
8
9  SUBROUTINE dia_wri (kt, kindic)
10    !!----------------------------------------------------------------------
11    !!           *** routine dia_wri ***
12    !!
13    !! ** Purpose : output dynamics and tracer fields on direct access file
14    !!              suitable for MPP computing
15    !!
16    !! ** define key : 'key_dimgout'
17    !!
18    !! **  Method : Default is to cumulate the values over the interval between
19    !!      2 output, and each nwrite time-steps  the mean value is  computed
20    !!      and written to the direct access file.
21    !!     If 'key_diainstant' is defined, no mean values are computed and the
22    !!     instantaneous fields are dump.
23    !!     kindic is 0 or >0 in normal condition. When < 0 it indicates an error
24    !!     condition and instantaneous file output is forced.
25    !!       Each processor creates its own file with its local data
26    !!     Merging all the files is performed off line by a dedicated program
27    !!
28    !! ** Arguments :
29    !!     kt      : time-step number
30    !!     kindinc :  error condition indicator : >=0 :  OK, < 0 : error.
31    !!
32    !! ** Naming convention for files
33    !!
34    !! {cexper}_{var}_y----m--d--.dimg
35    !!   cexper is the name of the experience, given in the namelist
36    !!   var can be either U, V, T, S, KZ, SSH, ...
37    !!   var can also be 2D, which means that each level of the file is a 2D field as described below
38    !!    y----m--d--  is the date at the time of the dump
39    !!    For mpp output, each processor dumps its own memory, on appropriate record range
40    !!    (direct access : for level jk of a klev field on proc narea irec = 1+ klev*(narea -1) + jk )
41    !!    To be tested with a lot of procs !!!!
42    !!
[32]43    !!  level 1:  taux(:,:) * umask(:,:,1) zonal stress in N.m-2
44    !!  level 2:  tauy(:,:) * vmask(:,:,1) meridional stress in N. m-2
[405]45    !!  level 3:   qt  (:,:)               total heat flux (W/m2)
46    !!  level 4:   emp (:,:)               E-P flux (mm/day)
47    !!  level 5:  tb  (:,:,1)-sst          model SST -forcing sst (degree C)
48    !!  level 6:  bsfb(:,:)         streamfunction (m**3/s)
49    !!  level 7:  qsr (:,:)         solar flux (W/m2)
50    !!  level 8:  qrp (:,:)                relax component of T flux.
51    !!  level 9:  erp (:,:)                relax component of S flux
52    !!  level 10: hmld(:,:)                turbocline depth
53    !!  level 11: hmlp(:,:)                mixed layer depth
54    !!  level 12: freeze (:,:)             Ice cover (1. or 0.)
55    !!  level 13: sst(:,:)                 the observed SST we relax to.
56    !!  level 14: qct(:,:)                 equivalent flux due to treshold SST
57    !!  level 15: fbt(:,:)                 feedback term .
58    !!  level 16: emps(:,:)                concentration/dilution water flux
59    !!  level 17: fsalt(:,:)               Ice=>ocean net freshwater
60    !!  level 18: gps(:,:)                 the surface pressure (m).
61    !!  level 19: spgu(:,:)                the surface pressure gradient in X direction.
62    !!  level 20: spgv(:,:)                the surface pressure gradient in Y direction.
[3]63    !!
64    !! History
65    !!      original  : 91-03 ()
66    !!      additions : 91-11 (G. Madec)
67    !!      additions : 92-06 (M. Imbard) correction restart file
68    !!      additions : 92-07 (M. Imbard) split into diawri and rstwri
69    !!      additions : 93-03 (M. Imbard) suppress writibm
70    !!      additions : 94-12 (M. Imbard) acces direct files
71    !!      additions : 97-2002 ( Clipper Group ) dimg files
72    !!                  dec 2003 ( J.M. Molines) f90, mpp output for OPA9.0
[405]73    !!   9.0  !  05-05  (S. Theetten) add emps fsalt move gps spgu spgv 2 lines below
[359]74    !!   9.0  !  05-11  (V. Garnier) Surface pressure gradient organization
[3]75    !!----------------------------------------------------------------------
76    !! * modules used
[32]77    USE lib_mpp
[3]78    USE dtasst, ONLY : sst
79
80    !! * Arguments
81    INTEGER ,INTENT(in) :: kt, kindic
82
83    !! * local declarations
[632]84    INTEGER :: inbsel, jk
[32]85!!  INTEGER :: iwrite
[3]86    INTEGER :: iyear,imon,iday
[182]87    INTEGER, SAVE :: nmoyct
[3]88
89#if defined key_diainstant
[182]90    LOGICAL, PARAMETER :: ll_dia_inst=.TRUE.  !: for instantaneous output
[3]91#else
[182]92    LOGICAL, PARAMETER :: ll_dia_inst=.FALSE. !: for average output
93#endif
[3]94
95    REAL(wp), SAVE, DIMENSION (jpi,jpj,jpk) ::  um , vm   ! used to compute mean u, v fields
[182]96    REAL(wp), SAVE, DIMENSION (jpi,jpj,jpk) ::  wm        ! used to compute mean w fields
[405]97    REAL(wp), SAVE, DIMENSION (jpi,jpj,jpk) ::  avtm      ! used to compute mean kz fields
[3]98    REAL(wp), SAVE, DIMENSION (jpi,jpj,jpk) ::  tm , sm   ! used to compute mean t, s fields
99    REAL(wp), SAVE, DIMENSION (jpi,jpj,jpk) ::  fsel      ! used to compute mean 2d fields
100    REAL(wp) :: zdtj
101    !
102    CHARACTER(LEN=80) :: clname
103    CHARACTER(LEN=80) :: cltext
104    CHARACTER(LEN=80) :: clmode
[32]105    CHARACTER(LEN= 4) :: clver
[3]106    !
107    !  Initialization
108    !  ---------------
109    !
110#ifdef key_diaspr
[405]111    inbsel = 20
[3]112#else
[405]113    inbsel = 17
[3]114#endif
[632]115#if defined key_flx_core
116    inbsel = 23
117#endif
[3]118
[405]119    IF( inbsel >  jpk) THEN
120       IF( lwp) WRITE(numout,*)  &
[3]121            ' STOP inbsel =',inbsel,' is larger than jpk=',jpk
122       STOP
[405]123    ENDIF
[3]124
125
126    iyear = ndastp/10000
127    imon = (ndastp-iyear*10000)/100
128    iday = ndastp - imon*100 - iyear*10000
129
130    !     
131    !! dimg format V1.0 should start with the 4 char. string '@!01'
132    !!
133    clver='@!01'
134    !
[405]135    IF( .NOT. ll_dia_inst ) THEN
[3]136       !
137       !! * Mean output section
138       !! ----------------------
139       !
[405]140       IF( kt == nit000 .AND. lwp ) WRITE(numout,*) &
[3]141            'THE OUTPUT FILES CONTAINS THE AVERAGE OF EACH FIELD'
142       !
[405]143       IF( kt == nit000  ) THEN
[3]144          ! reset arrays for average computation
145          nmoyct = 0
146          !
147          um(:,:,:) = 0._wp
148          vm(:,:,:) = 0._wp
[182]149          wm(:,:,:) = 0._wp
[405]150          avtm(:,:,:) = 0._wp
[3]151          tm(:,:,:) = 0._wp
152          sm(:,:,:) = 0._wp
153          fsel(:,:,:) = 0._wp
154          !
[405]155       ENDIF
[3]156
157       !  cumulate values
158       !  ---------------
159
160       nmoyct = nmoyct+1
161       !
162       um(:,:,:)=um(:,:,:) + un (:,:,:)
163       vm(:,:,:)=vm(:,:,:) + vn (:,:,:)
[182]164       wm(:,:,:)=wm(:,:,:) + wn (:,:,:)
[405]165       avtm(:,:,:)=avtm(:,:,:) + avt (:,:,:)
[3]166       tm(:,:,:)=tm(:,:,:) + tn (:,:,:)
167       sm(:,:,:)=sm(:,:,:) + sn (:,:,:)
168       !
169       fsel(:,:,1 ) = fsel(:,:,1 ) + taux(:,:) * umask(:,:,1)
170       fsel(:,:,2 ) = fsel(:,:,2 ) + tauy(:,:) * vmask(:,:,1)
[320]171       fsel(:,:,3 ) = fsel(:,:,3 ) + qt  (:,:)
[3]172       fsel(:,:,4 ) = fsel(:,:,4 ) + emp (:,:)
173       fsel(:,:,5 ) = fsel(:,:,5 ) + tb  (:,:,1) - sst(:,:)
[359]174#if ! defined key_dynspg_rl
[3]175       fsel(:,:,6 ) = fsel(:,:,6 ) + sshn(:,:)    ! SSH
176#else
177       fsel(:,:,6 ) = fsel(:,:,6 ) + bsfn(:,:)    ! BSF
178#endif
179       fsel(:,:,7 ) = fsel(:,:,7 ) + qsr(:,:)
180       fsel(:,:,8 ) = fsel(:,:,8 ) + qrp (:,:)
181       fsel(:,:,9 ) = fsel(:,:,9 ) + erp (:,:)
182       fsel(:,:,10) = fsel(:,:,10) + hmld(:,:)
183       fsel(:,:,11) = fsel(:,:,11) + hmlp(:,:)
184       fsel(:,:,12) = fsel(:,:,12) + freeze(:,:)
185       fsel(:,:,13) = fsel(:,:,13) + sst(:,:)
186       !        fsel(:,:,14) = fsel(:,:,14) + qct(:,:)
187       !        fsel(:,:,15) = fsel(:,:,15) + fbt(:,:)
[405]188       fsel(:,:,16) = fsel(:,:,16) + emps(:,:)
189#if defined key_ice_lim
190       fsel(:,:,17) = fsel(:,:,17) + fsalt(:,:)
191#endif
[3]192#ifdef key_diaspr   
[405]193       fsel(:,:,18) = fsel(:,:,18) + gps(:,:)/g
[3]194#endif
[632]195#if defined key_flx_core
196       fsel(:,:,21) = fsel(:,:,21) + qla(:,:)
197       fsel(:,:,22) = fsel(:,:,22) + qlw(:,:)
198       fsel(:,:,23) = fsel(:,:,23) + qsb(:,:)
199#endif
[3]200       !
201       ! Output of dynamics and tracer fields and selected fields (numwri)
202       ! -----------------------------------------------------------------
203       !
204       !
205       zdtj=rdt/86400.   ! time step in days
206       WRITE(clmode,'(f5.1,a)' ) nwrite*zdtj,' days average'
207
208       !       iwrite=NINT(adatrj/rwrite)
209       !      IF (abs(adatrj-iwrite*rwrite) < zdtj/2.      &
210
[405]211       IF(  ( MOD (kt-nit000+1,nwrite) ==  0 )          &
[3]212            &   .OR.       kindic <   0            &
213            &   .OR. ( kt == 1 .AND. kindic > 0)  ) THEN
214          ! it is time to make a dump on file
215          ! compute average
216          um(:,:,:) = um(:,:,:) / nmoyct
217          vm(:,:,:) = vm(:,:,:) / nmoyct
[182]218          wm(:,:,:) = wm(:,:,:) / nmoyct
[405]219          avtm(:,:,:) = avtm(:,:,:) / nmoyct
[3]220          tm(:,:,:) = tm(:,:,:) / nmoyct
221          sm(:,:,:) = sm(:,:,:) / nmoyct
222          !
223          fsel(:,:,:) = fsel(:,:,:) / nmoyct
224          !
225          ! note : the surface pressure is not averaged, but rather
226          ! computed from the averaged gradients.
227          !
228#ifdef key_diaspr
[405]229          fsel(:,:,18)= gps(:,:)/g
230          fsel(:,:,19)= spgu(:,:)
231          fsel(:,:,20)= spgv(:,:)
[3]232#endif
[632]233          ! mask mean field with tmask except taux tauy (1,2)
234          DO jk=3,inbsel
235            fsel(:,:,jk)=fsel(:,:,jk)*tmask(:,:,1)
236          END DO
[3]237       ENDIF
238       !
[182]239    ELSE   ! ll_dia_inst true
[3]240       !
241       !! * Instantaneous output section
242       !! ------------------------------
243       !
[405]244       IF( kt == nit000 .AND. lwp ) WRITE(numout,*) &
[3]245            'THE OUTPUT FILES CONTAINS INSTANTANEOUS VALUES OF EACH FIELD'
246       !
247       zdtj=rdt/86400.   ! time step in days
248       !  iwrite=NINT(adatrj/rwrite)
249       clmode='instantaneous'
250       !     IF (abs(adatrj-iwrite*rwrite) < zdtj/2.  &
[182]251       IF (  ( MOD (kt-nit000+1,nwrite) ==  0 )          &
[3]252            &   .OR.       kindic <   0            &
253            &   .OR. ( kt == 1 .AND. kindic > 0)  ) THEN
254          !
255          ! transfer wp arrays to sp arrays for dimg files
256          fsel(:,:,:) = 0._wp
257          !
258          fsel(:,:,1 ) = taux(:,:) * umask(:,:,1)
259          fsel(:,:,2 ) = tauy(:,:) * vmask(:,:,1)
[632]260          fsel(:,:,3 ) = qt  (:,:) * tmask(:,:,1)
261          fsel(:,:,4 ) = emp (:,:) * tmask(:,:,1)
[3]262          fsel(:,:,5 ) = (tb  (:,:,1) -sst(:,:)) *tmask(:,:,1)
263
[359]264#if ! defined key_dynspg_rl
[3]265          fsel(:,:,6 ) = sshn(:,:)
266#else
267          fsel(:,:,6 ) = bsfn(:,:)
268#endif
[632]269          fsel(:,:,7 ) = qsr (:,:) * tmask(:,:,1)
270          fsel(:,:,8 ) = qrp (:,:) * tmask(:,:,1)
271          fsel(:,:,9 ) = erp (:,:) * tmask(:,:,1)
272          fsel(:,:,10) = hmld(:,:) * tmask(:,:,1)
273          fsel(:,:,11) = hmlp(:,:) * tmask(:,:,1)
274          fsel(:,:,12) = freeze(:,:) * tmask(:,:,1)
[3]275          fsel(:,:,13) =  sst(:,:) 
276          !         fsel(:,:,14) =  qct(:,:)
277          !         fsel(:,:,15) =  fbt(:,:)
[632]278          fsel(:,:,16) =  emps(:,:) * tmask(:,:,1)
[405]279#if defined key_ice_lim
[632]280          fsel(:,:,17) =  fsalt(:,:) * tmask(:,:,1)
[405]281#endif
[3]282#ifdef key_diaspr           
[405]283          fsel(:,:,18) =      gps(:,:) /g
284          fsel(:,:,19) =      spgu(:,:)
285          fsel(:,:,20) =      spgv(:,:)
[3]286#endif
[632]287#if defined key_flx_core
288          fsel(:,:,21) =  qla(:,:)* tmask(:,:,1)
289          fsel(:,:,22) =  qlw(:,:)* tmask(:,:,1)
290          fsel(:,:,23) =  qsb(:,:)* tmask(:,:,1)
291#endif
[3]292          !
293          !         qct(:,:) = 0._wp
294       ENDIF
295    ENDIF
296    !
297    ! Opening of the datrj.out file with the absolute time in day of each dump
298    ! this file gives a record of the dump date for post processing ( ASCII file )
299    !
[405]300    IF(  ( MOD (kt-nit000+1,nwrite) ==  0 )          &
[3]301         &   .OR.       kindic <   0            &
302         &   .OR. ( kt == 1 .AND. kindic > 0)  ) THEN
303
[405]304       IF( lwp) WRITE(numout,*)'Days since the begining of the run :',adatrj
[3]305
306       !! * U section
307
308       WRITE(clname,9000) TRIM(cexper),'U',iyear,imon,iday
309       cltext=TRIM(cexper)//' U(m/s) '//TRIM(clmode)
310       IF ( kindic < 0 )   cltext=TRIM(cexper)//' U(m/s)  instantaneous (explosion)'
311       !
[405]312       IF( ll_dia_inst) THEN
[3]313          CALL dia_wri_dimg(clname, cltext, un, jpk, 'T')
314
315       ELSE
[405]316          IF( kindic ==  -3 ) THEN
[3]317             ! ... in case of explosion on umax, dump instantateous u field instead of mean.
318             CALL dia_wri_dimg(clname, cltext, un, jpk, 'T')
319          ELSE
320             CALL dia_wri_dimg(clname, cltext, um, jpk, 'T')
[405]321          ENDIF
[3]322       ENDIF
323
324       !! * V section
325
326       WRITE(clname,9000) TRIM(cexper),'V',iyear,imon,iday
327       cltext=TRIM(cexper)//' V(m/s) '//TRIM(clmode)
328       !
[405]329       IF( ll_dia_inst) THEN
[3]330          CALL dia_wri_dimg(clname, cltext, vn, jpk, 'T')
331       ELSE
332          CALL dia_wri_dimg(clname, cltext, vm, jpk, 'T')
[405]333       ENDIF
[3]334       !
335
336       !! * KZ section
337
338       WRITE(clname,9000) TRIM(cexper),'KZ',iyear,imon,iday
[405]339       cltext=TRIM(cexper)//' KZ(m2/s) '//TRIM(clmode)
[3]340
[405]341       IF( ll_dia_inst) THEN
342          CALL dia_wri_dimg(clname, cltext, avt, jpk, 'W')
343       ELSE
344          CALL dia_wri_dimg(clname, cltext, avtm, jpk, 'W')
345       ENDIF
[3]346       !
347
[182]348       !! * W section
349
350       WRITE(clname,9000) TRIM(cexper),'W',iyear,imon,iday
351       cltext=TRIM(cexper)//' W(m/s) '//TRIM(clmode)
352
[405]353       IF( ll_dia_inst) THEN
[182]354          CALL dia_wri_dimg(clname, cltext, wn, jpk, 'W')
355       ELSE
356          CALL dia_wri_dimg(clname, cltext, wm, jpk, 'W')
[405]357       ENDIF
[182]358
[3]359       !! * T section
360
361       WRITE(clname,9000) TRIM(cexper),'T',iyear,imon,iday
362       cltext=TRIM(cexper)//' T (DegC) '//TRIM(clmode)
363
[405]364       IF( ll_dia_inst) THEN
[3]365          CALL dia_wri_dimg(clname, cltext, tn, jpk, 'T')
366       ELSE
367          CALL dia_wri_dimg(clname, cltext, tm, jpk, 'T')
[405]368       ENDIF
[3]369       !
370
371       !! * S section
372
373       WRITE(clname,9000) TRIM(cexper),'S',iyear,imon,iday
374       cltext=TRIM(cexper)//' S (PSU) '//TRIM(clmode)
375
[405]376       IF( ll_dia_inst) THEN
[3]377          CALL dia_wri_dimg(clname, cltext, sn, jpk, 'T')
378       ELSE
379          CALL dia_wri_dimg(clname, cltext, sm, jpk, 'T')
[405]380       ENDIF
[3]381       !
382
383       !! * 2D section
384
385       WRITE(clname,9000) TRIM(cexper),'2D',iyear,imon,iday
386       cltext='2D fields '//TRIM(clmode)
387
[405]388       IF( ll_dia_inst) THEN
[3]389          CALL dia_wri_dimg(clname, cltext, fsel, inbsel, '2')
390       ELSE
391          CALL dia_wri_dimg(clname, cltext, fsel, inbsel, '2')
392       ENDIF
393
[32]394       IF( lk_mpp )   CALL mppsync   ! synchronization in mpp
[3]395
396       !! * Log message in numout
397
[405]398       IF( lwp)WRITE(numout,*) ' '
399       IF( lwp)WRITE(numout,*) ' **** WRITE in numwri ',kt
[3]400
[405]401       IF( lwp .AND.        ll_dia_inst) WRITE(numout,*) '    instantaneous fields'
402       IF( lwp .AND. .NOT.  ll_dia_inst) WRITE(numout,*) '    average fields with ',nmoyct,'pdt'
[3]403       !
404       !
405       !! * Reset cumulating arrays  and counter to 0 after writing
406       !
[405]407       IF( .NOT. ll_dia_inst ) THEN
[3]408          nmoyct = 0
409          !
410          um(:,:,:) = 0._wp
411          vm(:,:,:) = 0._wp
[574]412          wm(:,:,:) = 0._wp
[3]413          tm(:,:,:) = 0._wp
414          sm(:,:,:) = 0._wp
415          fsel(:,:,:) = 0._wp
[480]416          avtm(:,:,:) = 0._wp
[3]417       ENDIF
[405]418    ENDIF
[3]419    !
4209000 FORMAT(a,"_",a,"_y",i4.4,"m",i2.2,"d",i2.2,".dimgproc")
421
422  END SUBROUTINE dia_wri
423
424  SUBROUTINE dia_wri_state ( cdfile_name)
425    !!-------------------------------------------------------------------
426    !!        ***     ROUTINE dia_wri_state  ***
427    !!
[32]428    !! ** Purpose :   Dummy routine for compatibility with IOIPSL output
[3]429    !!
430    !! ** History :
431    !!      9.O  ! 03-06  (J.M. Molines ) dimgout
432    !!--------------------------------------------------------------------
433    !! * Arguments
[32]434    CHARACTER (len=*), INTENT(in) ::   cdfile_name   ! name of the file created
435    !!--------------------------------------------------------------------
[3]436
[405]437    IF( lwp) WRITE(numout,*) 'dia_wri_state: Dummy call', cdfile_name
438    IF( lwp) WRITE(numout,*) '-------------'
439    IF( lwp) WRITE(numout,*)
[3]440
441  END SUBROUTINE dia_wri_state
Note: See TracBrowser for help on using the repository browser.