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

Last change on this file since 1577 was 1577, checked in by smasson, 15 years ago

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