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 @ 405

Last change on this file since 405 was 405, checked in by opalod, 18 years ago

nemo_v1_024 : CT : bug fix for mean KZ output in dimg output format

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 15.1 KB
Line 
1  !!----------------------------------------------------------------------
2  !!                        ***  diawri_dimg.h90  ***
3  !!----------------------------------------------------------------------
4  !!   OPA 9.0 , LOCEAN-IPSL (2005)
5  !! $Header$
6  !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
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    !!
43    !!  level 1:  taux(:,:) * umask(:,:,1) zonal stress in N.m-2
44    !!  level 2:  tauy(:,:) * vmask(:,:,1) meridional stress in N. m-2
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.
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
73    !!   9.0  !  05-05  (S. Theetten) add emps fsalt move gps spgu spgv 2 lines below
74    !!   9.0  !  05-11  (V. Garnier) Surface pressure gradient organization
75    !!----------------------------------------------------------------------
76    !! * modules used
77    USE lib_mpp
78    USE dtasst, ONLY : sst
79
80    !! * Arguments
81    INTEGER ,INTENT(in) :: kt, kindic
82
83    !! * local declarations
84    INTEGER :: inbsel
85!!  INTEGER :: iwrite
86    INTEGER :: iyear,imon,iday
87    INTEGER, SAVE :: nmoyct
88
89#if defined key_diainstant
90    LOGICAL, PARAMETER :: ll_dia_inst=.TRUE.  !: for instantaneous output
91#else
92    LOGICAL, PARAMETER :: ll_dia_inst=.FALSE. !: for average output
93#endif
94
95    REAL(wp), SAVE, DIMENSION (jpi,jpj,jpk) ::  um , vm   ! used to compute mean u, v fields
96    REAL(wp), SAVE, DIMENSION (jpi,jpj,jpk) ::  wm        ! used to compute mean w fields
97    REAL(wp), SAVE, DIMENSION (jpi,jpj,jpk) ::  avtm      ! used to compute mean kz fields
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
105    CHARACTER(LEN= 4) :: clver
106    !
107    !  Initialization
108    !  ---------------
109    !
110#ifdef key_diaspr
111    inbsel = 20
112#else
113    inbsel = 17
114#endif
115
116    IF( inbsel >  jpk) THEN
117       IF( lwp) WRITE(numout,*)  &
118            ' STOP inbsel =',inbsel,' is larger than jpk=',jpk
119       STOP
120    ENDIF
121
122
123    iyear = ndastp/10000
124    imon = (ndastp-iyear*10000)/100
125    iday = ndastp - imon*100 - iyear*10000
126
127    !     
128    !! dimg format V1.0 should start with the 4 char. string '@!01'
129    !!
130    clver='@!01'
131    !
132    IF( .NOT. ll_dia_inst ) THEN
133       !#if ! defined key_diainstant
134       !
135       !! * Mean output section
136       !! ----------------------
137       !
138       IF( kt == nit000 .AND. lwp ) WRITE(numout,*) &
139            'THE OUTPUT FILES CONTAINS THE AVERAGE OF EACH FIELD'
140       !
141       IF( kt == nit000  ) THEN
142          ! reset arrays for average computation
143          nmoyct = 0
144          !
145          um(:,:,:) = 0._wp
146          vm(:,:,:) = 0._wp
147          wm(:,:,:) = 0._wp
148          avtm(:,:,:) = 0._wp
149          tm(:,:,:) = 0._wp
150          sm(:,:,:) = 0._wp
151          fsel(:,:,:) = 0._wp
152          !
153       ENDIF
154
155       !  cumulate values
156       !  ---------------
157
158       nmoyct = nmoyct+1
159       !
160       um(:,:,:)=um(:,:,:) + un (:,:,:)
161       vm(:,:,:)=vm(:,:,:) + vn (:,:,:)
162       wm(:,:,:)=wm(:,:,:) + wn (:,:,:)
163       avtm(:,:,:)=avtm(:,:,:) + avt (:,:,:)
164       tm(:,:,:)=tm(:,:,:) + tn (:,:,:)
165       sm(:,:,:)=sm(:,:,:) + sn (:,:,:)
166       !
167       fsel(:,:,1 ) = fsel(:,:,1 ) + taux(:,:) * umask(:,:,1)
168       fsel(:,:,2 ) = fsel(:,:,2 ) + tauy(:,:) * vmask(:,:,1)
169       fsel(:,:,3 ) = fsel(:,:,3 ) + qt  (:,:)
170       fsel(:,:,4 ) = fsel(:,:,4 ) + emp (:,:)
171       fsel(:,:,5 ) = fsel(:,:,5 ) + tb  (:,:,1) - sst(:,:)
172#if ! defined key_dynspg_rl
173       fsel(:,:,6 ) = fsel(:,:,6 ) + sshn(:,:)    ! SSH
174#else
175       fsel(:,:,6 ) = fsel(:,:,6 ) + bsfn(:,:)    ! BSF
176#endif
177       fsel(:,:,7 ) = fsel(:,:,7 ) + qsr(:,:)
178       fsel(:,:,8 ) = fsel(:,:,8 ) + qrp (:,:)
179       fsel(:,:,9 ) = fsel(:,:,9 ) + erp (:,:)
180       fsel(:,:,10) = fsel(:,:,10) + hmld(:,:)
181       fsel(:,:,11) = fsel(:,:,11) + hmlp(:,:)
182       fsel(:,:,12) = fsel(:,:,12) + freeze(:,:)
183       fsel(:,:,13) = fsel(:,:,13) + sst(:,:)
184       !        fsel(:,:,14) = fsel(:,:,14) + qct(:,:)
185       !        fsel(:,:,15) = fsel(:,:,15) + fbt(:,:)
186       fsel(:,:,16) = fsel(:,:,16) + emps(:,:)
187#if defined key_ice_lim
188       fsel(:,:,17) = fsel(:,:,17) + fsalt(:,:)
189#endif
190#ifdef key_diaspr   
191       fsel(:,:,18) = fsel(:,:,18) + gps(:,:)/g
192#endif
193       !
194       ! Output of dynamics and tracer fields and selected fields (numwri)
195       ! -----------------------------------------------------------------
196       !
197       !
198       zdtj=rdt/86400.   ! time step in days
199       WRITE(clmode,'(f5.1,a)' ) nwrite*zdtj,' days average'
200
201       !       iwrite=NINT(adatrj/rwrite)
202       !      IF (abs(adatrj-iwrite*rwrite) < zdtj/2.      &
203
204       IF(  ( MOD (kt-nit000+1,nwrite) ==  0 )          &
205            &   .OR.       kindic <   0            &
206            &   .OR. ( kt == 1 .AND. kindic > 0)  ) THEN
207          ! it is time to make a dump on file
208          ! compute average
209          um(:,:,:) = um(:,:,:) / nmoyct
210          vm(:,:,:) = vm(:,:,:) / nmoyct
211          wm(:,:,:) = wm(:,:,:) / nmoyct
212          avtm(:,:,:) = avtm(:,:,:) / nmoyct
213          tm(:,:,:) = tm(:,:,:) / nmoyct
214          sm(:,:,:) = sm(:,:,:) / nmoyct
215          !
216          fsel(:,:,:) = fsel(:,:,:) / nmoyct
217          !
218          ! note : the surface pressure is not averaged, but rather
219          ! computed from the averaged gradients.
220          !
221#ifdef key_diaspr
222          fsel(:,:,18)= gps(:,:)/g
223          fsel(:,:,19)= spgu(:,:)
224          fsel(:,:,20)= spgv(:,:)
225#endif
226       ENDIF
227       !
228    ELSE   ! ll_dia_inst true
229       !#  else
230       !
231       !! * Instantaneous output section
232       !! ------------------------------
233       !
234       IF( kt == nit000 .AND. lwp ) WRITE(numout,*) &
235            'THE OUTPUT FILES CONTAINS INSTANTANEOUS VALUES OF EACH FIELD'
236       !
237       zdtj=rdt/86400.   ! time step in days
238       !  iwrite=NINT(adatrj/rwrite)
239       clmode='instantaneous'
240       !     IF (abs(adatrj-iwrite*rwrite) < zdtj/2.  &
241       IF (  ( MOD (kt-nit000+1,nwrite) ==  0 )          &
242            &   .OR.       kindic <   0            &
243            &   .OR. ( kt == 1 .AND. kindic > 0)  ) THEN
244          !
245          ! transfer wp arrays to sp arrays for dimg files
246          fsel(:,:,:) = 0._wp
247          !
248          fsel(:,:,1 ) = taux(:,:) * umask(:,:,1)
249          fsel(:,:,2 ) = tauy(:,:) * vmask(:,:,1)
250          fsel(:,:,3 ) = qt  (:,:)
251          fsel(:,:,4 ) = emp (:,:)
252          fsel(:,:,5 ) = (tb  (:,:,1) -sst(:,:)) *tmask(:,:,1)
253
254#if ! defined key_dynspg_rl
255          fsel(:,:,6 ) = sshn(:,:)
256#else
257          fsel(:,:,6 ) = bsfn(:,:)
258#endif
259          fsel(:,:,7 ) = qsr (:,:)
260          fsel(:,:,8 ) = qrp (:,:)
261          fsel(:,:,9 ) = erp (:,:)*tmask(:,:,1)
262          fsel(:,:,10) = hmld(:,:)
263          fsel(:,:,11) = hmlp(:,:)
264          fsel(:,:,12) = freeze(:,:)
265          fsel(:,:,13) =  sst(:,:) 
266          !         fsel(:,:,14) =  qct(:,:)
267          !         fsel(:,:,15) =  fbt(:,:)
268          fsel(:,:,16) =  emps(:,:)
269#if defined key_ice_lim
270          fsel(:,:,17) =  fsalt(:,:)
271#endif
272#ifdef key_diaspr           
273          fsel(:,:,18) =      gps(:,:) /g
274          fsel(:,:,19) =      spgu(:,:)
275          fsel(:,:,20) =      spgv(:,:)
276#endif
277          !
278          !         qct(:,:) = 0._wp
279       ENDIF
280       !#endif
281    ENDIF
282    !
283    ! Opening of the datrj.out file with the absolute time in day of each dump
284    ! this file gives a record of the dump date for post processing ( ASCII file )
285    !
286    IF(  ( MOD (kt-nit000+1,nwrite) ==  0 )          &
287         &   .OR.       kindic <   0            &
288         &   .OR. ( kt == 1 .AND. kindic > 0)  ) THEN
289       OPEN (14,FILE='datrj.out',FORM='FORMATTED', STATUS='UNKNOWN',POSITION='APPEND ')
290
291       IF( lwp) WRITE(14,'(f10.4,1x,i8)') adatrj, ndastp
292       CLOSE(14)
293
294       IF( lwp) WRITE(numout,*)'Days since the begining of the run :',adatrj
295
296       !! * U section
297
298       WRITE(clname,9000) TRIM(cexper),'U',iyear,imon,iday
299       cltext=TRIM(cexper)//' U(m/s) '//TRIM(clmode)
300       IF ( kindic < 0 )   cltext=TRIM(cexper)//' U(m/s)  instantaneous (explosion)'
301       !
302       IF( ll_dia_inst) THEN
303          CALL dia_wri_dimg(clname, cltext, un, jpk, 'T')
304
305       ELSE
306          IF( kindic ==  -3 ) THEN
307             ! ... in case of explosion on umax, dump instantateous u field instead of mean.
308             CALL dia_wri_dimg(clname, cltext, un, jpk, 'T')
309          ELSE
310             CALL dia_wri_dimg(clname, cltext, um, jpk, 'T')
311          ENDIF
312       ENDIF
313
314       !! * V section
315
316       WRITE(clname,9000) TRIM(cexper),'V',iyear,imon,iday
317       cltext=TRIM(cexper)//' V(m/s) '//TRIM(clmode)
318       !
319       IF( ll_dia_inst) THEN
320          CALL dia_wri_dimg(clname, cltext, vn, jpk, 'T')
321       ELSE
322          CALL dia_wri_dimg(clname, cltext, vm, jpk, 'T')
323       ENDIF
324       !
325
326       !! * KZ section
327
328       WRITE(clname,9000) TRIM(cexper),'KZ',iyear,imon,iday
329       cltext=TRIM(cexper)//' KZ(m2/s) '//TRIM(clmode)
330
331       IF( ll_dia_inst) THEN
332          CALL dia_wri_dimg(clname, cltext, avt, jpk, 'W')
333       ELSE
334          CALL dia_wri_dimg(clname, cltext, avtm, jpk, 'W')
335       ENDIF
336       !
337
338       !! * W section
339
340       WRITE(clname,9000) TRIM(cexper),'W',iyear,imon,iday
341       cltext=TRIM(cexper)//' W(m/s) '//TRIM(clmode)
342
343       IF( ll_dia_inst) THEN
344          CALL dia_wri_dimg(clname, cltext, wn, jpk, 'W')
345       ELSE
346          CALL dia_wri_dimg(clname, cltext, wm, jpk, 'W')
347       ENDIF
348
349       !! * T section
350
351       WRITE(clname,9000) TRIM(cexper),'T',iyear,imon,iday
352       cltext=TRIM(cexper)//' T (DegC) '//TRIM(clmode)
353
354       IF( ll_dia_inst) THEN
355          CALL dia_wri_dimg(clname, cltext, tn, jpk, 'T')
356       ELSE
357          CALL dia_wri_dimg(clname, cltext, tm, jpk, 'T')
358       ENDIF
359       !
360
361       !! * S section
362
363       WRITE(clname,9000) TRIM(cexper),'S',iyear,imon,iday
364       cltext=TRIM(cexper)//' S (PSU) '//TRIM(clmode)
365
366       IF( ll_dia_inst) THEN
367          CALL dia_wri_dimg(clname, cltext, sn, jpk, 'T')
368       ELSE
369          CALL dia_wri_dimg(clname, cltext, sm, jpk, 'T')
370       ENDIF
371       !
372
373       !! * 2D section
374
375       WRITE(clname,9000) TRIM(cexper),'2D',iyear,imon,iday
376       cltext='2D fields '//TRIM(clmode)
377
378       IF( ll_dia_inst) THEN
379          CALL dia_wri_dimg(clname, cltext, fsel, inbsel, '2')
380       ELSE
381          CALL dia_wri_dimg(clname, cltext, fsel, inbsel, '2')
382       ENDIF
383
384       IF( lk_mpp )   CALL mppsync   ! synchronization in mpp
385
386       !! * Log message in numout
387
388       IF( lwp)WRITE(numout,*) ' '
389       IF( lwp)WRITE(numout,*) ' **** WRITE in numwri ',kt
390
391       IF( lwp .AND.        ll_dia_inst) WRITE(numout,*) '    instantaneous fields'
392       IF( lwp .AND. .NOT.  ll_dia_inst) WRITE(numout,*) '    average fields with ',nmoyct,'pdt'
393       !
394       !
395       !! * Reset cumulating arrays  and counter to 0 after writing
396       !
397       IF( .NOT. ll_dia_inst ) THEN
398          nmoyct = 0
399          !
400          um(:,:,:) = 0._wp
401          vm(:,:,:) = 0._wp
402          tm(:,:,:) = 0._wp
403          sm(:,:,:) = 0._wp
404          fsel(:,:,:) = 0._wp
405          avtm(:,:,:) = O._wp
406       ENDIF
407    ENDIF
408    !
4099000 FORMAT(a,"_",a,"_y",i4.4,"m",i2.2,"d",i2.2,".dimgproc")
410
411  END SUBROUTINE dia_wri
412
413  SUBROUTINE dia_wri_state ( cdfile_name)
414    !!-------------------------------------------------------------------
415    !!        ***     ROUTINE dia_wri_state  ***
416    !!
417    !! ** Purpose :   Dummy routine for compatibility with IOIPSL output
418    !!
419    !! ** History :
420    !!      9.O  ! 03-06  (J.M. Molines ) dimgout
421    !!--------------------------------------------------------------------
422    !! * Arguments
423    CHARACTER (len=*), INTENT(in) ::   cdfile_name   ! name of the file created
424    !!--------------------------------------------------------------------
425
426    IF( lwp) WRITE(numout,*) 'dia_wri_state: Dummy call', cdfile_name
427    IF( lwp) WRITE(numout,*) '-------------'
428    IF( lwp) WRITE(numout,*)
429
430  END SUBROUTINE dia_wri_state
Note: See TracBrowser for help on using the repository browser.