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 branches/DEV_r1784_mid_year_merge_2010/NEMO/OPA_SRC/DIA – NEMO

source: branches/DEV_r1784_mid_year_merge_2010/NEMO/OPA_SRC/DIA/diawri_dimg.h90 @ 2000

Last change on this file since 2000 was 2000, checked in by acc, 14 years ago

ticket #684 step 7: Add in changes between the head of the DEV_r1821_Rivers branch and the trunk@1821. Note untested changes were made to the Rivers branch before this merge see wiki ticket page for details

  • 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 (:,:)-rnf(:,:) )   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(:,:) - rnf(:,:) ) 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(:,:)-rnf(:,:) )
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       fsel(:,:,10) = fsel(:,:,10) + hmld(:,:)
176       fsel(:,:,11) = fsel(:,:,11) + hmlp(:,:)
177       fsel(:,:,12) = fsel(:,:,12) + fr_i(:,:)
178       !        fsel(:,:,13) = fsel(:,:,13)   !RB not used
179       !        fsel(:,:,14) = fsel(:,:,14) + qct(:,:)
180       !        fsel(:,:,15) = fsel(:,:,15) + fbt(:,:)
181       fsel(:,:,16) = fsel(:,:,16) + ( emps(:,:)-rnf(:,:) )
182#ifdef key_diaspr   
183       fsel(:,:,18) = fsel(:,:,18) + gps(:,:)/g
184#endif
185       !
186       ! Output of dynamics and tracer fields and selected fields
187       ! --------------------------------------------------------
188       !
189       !
190       zdtj=rdt/86400.   ! time step in days
191       WRITE(clmode,'(f5.1,a)' ) nwrite*zdtj,' days average'
192
193       !       iwrite=NINT(adatrj/rwrite)
194       !      IF (abs(adatrj-iwrite*rwrite) < zdtj/2.      &
195
196       IF(  ( MOD (kt-nit000+1,nwrite) ==  0 )          &
197            &   .OR. ( kt == 1 .AND. ninist ==1 )  ) THEN
198          ! it is time to make a dump on file
199          ! compute average
200          um(:,:,:) = um(:,:,:) / nmoyct
201          vm(:,:,:) = vm(:,:,:) / nmoyct
202          wm(:,:,:) = wm(:,:,:) / nmoyct
203          avtm(:,:,:) = avtm(:,:,:) / nmoyct
204          tm(:,:,:) = tm(:,:,:) / nmoyct
205          sm(:,:,:) = sm(:,:,:) / nmoyct
206          !
207          fsel(:,:,:) = fsel(:,:,:) / nmoyct
208          !
209          ! note : the surface pressure is not averaged, but rather
210          ! computed from the averaged gradients.
211          !
212#ifdef key_diaspr
213          fsel(:,:,18)= gps(:,:)/g
214          fsel(:,:,19)= spgu(:,:)
215          fsel(:,:,20)= spgv(:,:)
216#endif
217          ! mask mean field with tmask except utau vtau (1,2)
218          DO jk=3,inbsel
219            fsel(:,:,jk)=fsel(:,:,jk)*tmask(:,:,1)
220          END DO
221       ENDIF
222       !
223    ELSE   ! ll_dia_inst true
224       !
225       !! * Instantaneous output section
226       !! ------------------------------
227       !
228       IF( kt == nit000 .AND. lwp ) WRITE(numout,*) &
229            'THE OUTPUT FILES CONTAINS INSTANTANEOUS VALUES OF EACH FIELD'
230       !
231       zdtj=rdt/86400.   ! time step in days
232       !  iwrite=NINT(adatrj/rwrite)
233       clmode='instantaneous'
234       !     IF (abs(adatrj-iwrite*rwrite) < zdtj/2.  &
235       IF (  ( MOD (kt-nit000+1,nwrite) ==  0 )          &
236            &   .OR. ( kt == 1 .AND. ninist == 1 )  ) THEN
237          !
238          ! transfer wp arrays to sp arrays for dimg files
239          fsel(:,:,:) = 0._wp
240          !
241          fsel(:,:,1 ) = utau(:,:) * umask(:,:,1)
242          fsel(:,:,2 ) = vtau(:,:) * vmask(:,:,1)
243          fsel(:,:,3 ) = (qsr (:,:) + qns (:,:)) * tmask(:,:,1)
244          fsel(:,:,4 ) = ( emp(:,:)-rnf(:,:) ) * tmask(:,:,1)
245          !         fsel(:,:,5 ) = (tb  (:,:,1) - sf_sst(1)%fnow(:,:) ) *tmask(:,:,1) !RB not used
246
247          fsel(:,:,6 ) = sshn(:,:)
248          fsel(:,:,7 ) = qsr (:,:) * tmask(:,:,1)
249          fsel(:,:,8 ) = qrp (:,:) * tmask(:,:,1)
250          fsel(:,:,9 ) = erp (:,:) * tmask(:,:,1)
251          fsel(:,:,10) = hmld(:,:) * tmask(:,:,1)
252          fsel(:,:,11) = hmlp(:,:) * tmask(:,:,1)
253          fsel(:,:,12) = fr_i(:,:) * tmask(:,:,1)
254          !         fsel(:,:,13) = sf_sst(1)%fnow(:,:) !RB not used
255          !         fsel(:,:,14) =  qct(:,:)
256          !         fsel(:,:,15) =  fbt(:,:)
257          fsel(:,:,16) = ( emps(:,:)-rnf(:,:) ) * tmask(:,:,1)
258#ifdef key_diaspr           
259          fsel(:,:,18) =      gps(:,:) /g
260          fsel(:,:,19) =      spgu(:,:)
261          fsel(:,:,20) =      spgv(:,:)
262#endif
263          !
264          !         qct(:,:) = 0._wp
265       ENDIF
266    ENDIF
267    !
268    ! Opening of the datrj.out file with the absolute time in day of each dump
269    ! this file gives a record of the dump date for post processing ( ASCII file )
270    !
271    IF(  ( MOD (kt-nit000+1,nwrite) ==  0 )          &
272         &   .OR. ( kt == 1 .AND. ninist == 1 )  ) THEN
273
274       IF( lwp) WRITE(numout,*)'Days since the begining of the run :',adatrj
275
276       !! * U section
277
278       WRITE(clname,9000) TRIM(cexper),'U',iyear,imon,iday
279       cltext=TRIM(cexper)//' U(m/s) '//TRIM(clmode)
280       !
281       IF( ll_dia_inst) THEN
282          CALL dia_wri_dimg(clname, cltext, un, jpk, 'T')
283
284       ELSE
285          CALL dia_wri_dimg(clname, cltext, um, jpk, 'T')
286       ENDIF
287
288       !! * V section
289
290       WRITE(clname,9000) TRIM(cexper),'V',iyear,imon,iday
291       cltext=TRIM(cexper)//' V(m/s) '//TRIM(clmode)
292       !
293       IF( ll_dia_inst) THEN
294          CALL dia_wri_dimg(clname, cltext, vn, jpk, 'T')
295       ELSE
296          CALL dia_wri_dimg(clname, cltext, vm, jpk, 'T')
297       ENDIF
298       !
299
300       !! * KZ section
301
302       WRITE(clname,9000) TRIM(cexper),'KZ',iyear,imon,iday
303       cltext=TRIM(cexper)//' KZ(m2/s) '//TRIM(clmode)
304
305       IF( ll_dia_inst) THEN
306          CALL dia_wri_dimg(clname, cltext, avt, jpk, 'W')
307       ELSE
308          CALL dia_wri_dimg(clname, cltext, avtm, jpk, 'W')
309       ENDIF
310       !
311
312       !! * W section
313
314       WRITE(clname,9000) TRIM(cexper),'W',iyear,imon,iday
315       cltext=TRIM(cexper)//' W(m/s) '//TRIM(clmode)
316
317       IF( ll_dia_inst) THEN
318          CALL dia_wri_dimg(clname, cltext, wn, jpk, 'W')
319       ELSE
320          CALL dia_wri_dimg(clname, cltext, wm, jpk, 'W')
321       ENDIF
322
323       !! * T section
324
325       WRITE(clname,9000) TRIM(cexper),'T',iyear,imon,iday
326       cltext=TRIM(cexper)//' T (DegC) '//TRIM(clmode)
327
328       IF( ll_dia_inst) THEN
329          CALL dia_wri_dimg(clname, cltext, tn, jpk, 'T')
330       ELSE
331          CALL dia_wri_dimg(clname, cltext, tm, jpk, 'T')
332       ENDIF
333       !
334
335       !! * S section
336
337       WRITE(clname,9000) TRIM(cexper),'S',iyear,imon,iday
338       cltext=TRIM(cexper)//' S (PSU) '//TRIM(clmode)
339
340       IF( ll_dia_inst) THEN
341          CALL dia_wri_dimg(clname, cltext, sn, jpk, 'T')
342       ELSE
343          CALL dia_wri_dimg(clname, cltext, sm, jpk, 'T')
344       ENDIF
345       !
346
347       !! * 2D section
348
349       WRITE(clname,9000) TRIM(cexper),'2D',iyear,imon,iday
350       cltext='2D fields '//TRIM(clmode)
351
352       IF( ll_dia_inst) THEN
353          CALL dia_wri_dimg(clname, cltext, fsel, inbsel, '2')
354       ELSE
355          CALL dia_wri_dimg(clname, cltext, fsel, inbsel, '2')
356       ENDIF
357
358       IF( lk_mpp )   CALL mppsync   ! synchronization in mpp
359
360       !! * Log message in numout
361
362       IF( lwp)WRITE(numout,*) ' '
363       IF( lwp)WRITE(numout,*) ' **** WRITE in dimg file ',kt
364
365       IF( lwp .AND.        ll_dia_inst) WRITE(numout,*) '    instantaneous fields'
366       IF( lwp .AND. .NOT.  ll_dia_inst) WRITE(numout,*) '    average fields with ',nmoyct,'pdt'
367       !
368       !
369       !! * Reset cumulating arrays  and counter to 0 after writing
370       !
371       IF( .NOT. ll_dia_inst ) THEN
372          nmoyct = 0
373          !
374          um(:,:,:) = 0._wp
375          vm(:,:,:) = 0._wp
376          wm(:,:,:) = 0._wp
377          tm(:,:,:) = 0._wp
378          sm(:,:,:) = 0._wp
379          fsel(:,:,:) = 0._wp
380          avtm(:,:,:) = 0._wp
381       ENDIF
382    ENDIF
383    !
3849000 FORMAT(a,"_",a,"_y",i4.4,"m",i2.2,"d",i2.2,".dimgproc")
385
386  END SUBROUTINE dia_wri
Note: See TracBrowser for help on using the repository browser.