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/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/DIA – NEMO

source: branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/DIA/diawri_dimg.h90 @ 3625

Last change on this file since 3625 was 3625, checked in by acc, 11 years ago

Branch dev_NOC_2012_r3555. #1006. Step 7. Check in code now merged with dev_r3385_NOCS04_HAMF
  • Property svn:keywords set to Id
File size: 13.9 KB
Line 
1  !!----------------------------------------------------------------------
2  !!                        ***  diawri_dimg.h90  ***
3  !!----------------------------------------------------------------------
4  !! NEMO/OPA 3.3 , NEMO Consortium (2010)
5  !! $Id $
6  !! Software governed by the CeCILL licence     (NEMOGCM/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: ( emp * sss )            concentration/dilution term on salinity
57    !!  level 17: ( emp * sst )            concentration/dilution term on temperature
58    !!  level 17: fsalt(:,:)               Ice=>ocean net freshwater
59    !!  level 18: gps(:,:)                 the surface pressure (m).
60    !!  level 19: spgu(:,:)                the surface pressure gradient in X direction.
61    !!  level 20: spgv(:,:)                the surface pressure gradient in Y direction.
62    !!
63    !! History:  OPA  ! 1997-02 ( Clipper Group ) dimg files
64    !!            -   ! 2003-12 ( J.M. Molines) f90, mpp output for OPA9.0
65    !!   NEMO    1.0  ! 2005-05  (S. Theetten) add emps fsalt move gps spgu spgv 2 lines below
66    !!            -   ! 2005-11  (V. Garnier) Surface pressure gradient organization
67    !!----------------------------------------------------------------------
68    USE lib_mpp
69    !!
70    INTEGER ,INTENT(in) :: kt
71    !!
72#if defined key_diainstant
73    LOGICAL, PARAMETER :: ll_dia_inst=.TRUE.  !: for instantaneous output
74#else
75    LOGICAL, PARAMETER :: ll_dia_inst=.FALSE. !: for average output
76#endif
77    INTEGER              , SAVE                    ::  nmoyct
78    REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:,:,:) ::  um , vm, wm   ! mean u, v, w fields
79    REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:,:,:) ::  avtm          ! mean kz fields
80    REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:,:,:) ::  tm , sm       ! mean t, s fields
81    REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:,:,:) ::  fsel          ! mean 2d fields
82   
83    INTEGER :: inbsel, jk
84    INTEGER :: iyear,imon,iday
85    INTEGER :: ialloc
86    REAL(wp) :: zdtj
87    CHARACTER(LEN=80) :: clname
88    CHARACTER(LEN=80) :: cltext
89    CHARACTER(LEN=80) :: clmode
90    CHARACTER(LEN= 4) :: clver
91    !!----------------------------------------------------------------------
92    IF( nn_timing == 1 )   CALL timing_start('dia_wri')
93    !
94    !  Initialization
95    !  ---------------
96    !
97    IF( .NOT. ALLOCATED(um) )THEN
98       ALLOCATE(um(jpi,jpj,jpk), vm(jpi,jpj,jpk), &
99                wm(jpi,jpj,jpk),                  &
100                avtm(jpi,jpj,jpk),                &
101                tm(jpi,jpj,jpk), sm(jpi,jpj,jpk), &
102                fsel(jpi,jpj,jpk),                &
103                STAT=ialloc )
104       !
105       IF( lk_mpp      )   CALL mpp_sum ( ialloc  )
106       IF( ialloc /= 0 )   CALL ctl_warn('dia_wri( diawri_dimg.h90) : failed to allocate arrays')
107    ENDIF
108
109
110    inbsel = 18
111
112    IF( inbsel >  jpk ) THEN
113       IF(lwp) WRITE(numout,*)  ' STOP inbsel =',inbsel,' is larger than jpk=',jpk
114       STOP
115    ENDIF
116
117    iyear = ndastp/10000
118    imon = (ndastp-iyear*10000)/100
119    iday = ndastp - imon*100 - iyear*10000
120
121    !     
122    !! dimg format V1.0 should start with the 4 char. string '@!01'
123    !!
124    clver='@!01'
125    !
126    IF( .NOT. ll_dia_inst ) THEN
127       !
128       !! * Mean output section
129       !! ----------------------
130       !
131       IF( kt == nit000 .AND. lwp ) WRITE(numout,*) &
132            'THE OUTPUT FILES CONTAINS THE AVERAGE OF EACH FIELD'
133       !
134       IF( kt == nit000  ) THEN
135          ! reset arrays for average computation
136          nmoyct = 0
137          !
138          um(:,:,:) = 0._wp
139          vm(:,:,:) = 0._wp
140          wm(:,:,:) = 0._wp
141          avtm(:,:,:) = 0._wp
142          tm(:,:,:) = 0._wp
143          sm(:,:,:) = 0._wp
144          fsel(:,:,:) = 0._wp
145          !
146       ENDIF
147
148       !  cumulate values
149       !  ---------------
150
151       nmoyct = nmoyct+1
152       !
153       um(:,:,:)=um(:,:,:) + un (:,:,:)
154       vm(:,:,:)=vm(:,:,:) + vn (:,:,:)
155       wm(:,:,:)=wm(:,:,:) + wn (:,:,:)
156       avtm(:,:,:)=avtm(:,:,:) + avt (:,:,:)
157       tm(:,:,:)=tm(:,:,:) + tsn(:,:,:,jp_tem)
158       sm(:,:,:)=sm(:,:,:) + tsn(:,:,:,jp_sal)
159       !
160       fsel(:,:,1 ) = fsel(:,:,1 ) + utau(:,:) * umask(:,:,1)
161       fsel(:,:,2 ) = fsel(:,:,2 ) + vtau(:,:) * vmask(:,:,1)
162       fsel(:,:,3 ) = fsel(:,:,3 ) + qsr (:,:) + qns  (:,:)
163       fsel(:,:,4 ) = fsel(:,:,4 ) + ( emp(:,:)-rnf(:,:) )
164       !        fsel(:,:,5 ) = fsel(:,:,5 ) + tsb(:,:,1,jp_tem)  !RB not used
165       fsel(:,:,6 ) = fsel(:,:,6 ) + sshn(:,:)
166       fsel(:,:,7 ) = fsel(:,:,7 ) + qsr(:,:)
167       fsel(:,:,8 ) = fsel(:,:,8 ) + qrp (:,:)
168       fsel(:,:,9 ) = fsel(:,:,9 ) + erp (:,:)
169       fsel(:,:,10) = fsel(:,:,10) + hmld(:,:)
170       fsel(:,:,11) = fsel(:,:,11) + hmlp(:,:)
171       fsel(:,:,12) = fsel(:,:,12) + fr_i(:,:)
172       !        fsel(:,:,13) = fsel(:,:,13)   !RB not used
173       !        fsel(:,:,14) = fsel(:,:,14) + qct(:,:)
174       !        fsel(:,:,15) = fsel(:,:,15) + fbt(:,:)
175       fsel(:,:,16) = fsel(:,:,16) + ( emp(:,:)*tsn(:,:,1,jp_sal) )
176       fsel(:,:,17) = fsel(:,:,17) + ( emp(:,:)*tsn(:,:,1,jp_tem) )
177       !
178       ! Output of dynamics and tracer fields and selected fields
179       ! --------------------------------------------------------
180       !
181       !
182       zdtj=rdt/86400.   ! time step in days
183       WRITE(clmode,'(f5.1,a)' ) nwrite*zdtj,' days average'
184
185       !       iwrite=NINT(adatrj/rwrite)
186       !      IF (abs(adatrj-iwrite*rwrite) < zdtj/2.      &
187
188       IF(  ( MOD (kt-nit000+1,nwrite) ==  0 )          &
189            &   .OR. ( kt == 1 .AND. ninist ==1 )  ) THEN
190          ! it is time to make a dump on file
191          ! compute average
192          um(:,:,:) = um(:,:,:) / nmoyct
193          vm(:,:,:) = vm(:,:,:) / nmoyct
194          wm(:,:,:) = wm(:,:,:) / nmoyct
195          avtm(:,:,:) = avtm(:,:,:) / nmoyct
196          tm(:,:,:) = tm(:,:,:) / nmoyct
197          sm(:,:,:) = sm(:,:,:) / nmoyct
198          !
199          fsel(:,:,:) = fsel(:,:,:) / nmoyct
200          !
201          ! note : the surface pressure is not averaged, but rather
202          ! computed from the averaged gradients.
203          !
204          ! mask mean field with tmask except utau vtau (1,2)
205          DO jk=3,inbsel
206            fsel(:,:,jk)=fsel(:,:,jk)*tmask(:,:,1)
207          END DO
208       ENDIF
209       !
210    ELSE   ! ll_dia_inst true
211       !
212       !! * Instantaneous output section
213       !! ------------------------------
214       !
215       IF( kt == nit000 .AND. lwp ) WRITE(numout,*) &
216            'THE OUTPUT FILES CONTAINS INSTANTANEOUS VALUES OF EACH FIELD'
217       !
218       zdtj=rdt/86400.   ! time step in days
219       !  iwrite=NINT(adatrj/rwrite)
220       clmode='instantaneous'
221       !     IF (abs(adatrj-iwrite*rwrite) < zdtj/2.  &
222       IF (  ( MOD (kt-nit000+1,nwrite) ==  0 )          &
223            &   .OR. ( kt == 1 .AND. ninist == 1 )  ) THEN
224          !
225          ! transfer wp arrays to sp arrays for dimg files
226          fsel(:,:,:) = 0._wp
227          !
228          fsel(:,:,1 ) = utau(:,:) * umask(:,:,1)
229          fsel(:,:,2 ) = vtau(:,:) * vmask(:,:,1)
230          fsel(:,:,3 ) = (qsr (:,:) + qns (:,:)) * tmask(:,:,1)
231          fsel(:,:,4 ) = ( emp(:,:)-rnf(:,:) ) * tmask(:,:,1)
232          !         fsel(:,:,5 ) = (tsb(:,:,1,jp_tem) - sf_sst(1)%fnow(:,:) ) *tmask(:,:,1) !RB not used
233
234          fsel(:,:,6 ) = sshn(:,:)
235          fsel(:,:,7 ) = qsr (:,:) * tmask(:,:,1)
236          fsel(:,:,8 ) = qrp (:,:) * tmask(:,:,1)
237          fsel(:,:,9 ) = erp (:,:) * tmask(:,:,1)
238          fsel(:,:,10) = hmld(:,:) * tmask(:,:,1)
239          fsel(:,:,11) = hmlp(:,:) * tmask(:,:,1)
240          fsel(:,:,12) = fr_i(:,:) * tmask(:,:,1)
241          !         fsel(:,:,13) = sf_sst(1)%fnow(:,:) !RB not used
242          !         fsel(:,:,14) =  qct(:,:)
243          !         fsel(:,:,15) =  fbt(:,:)
244          fsel(:,:,16) = ( emp(:,:)-tsn(:,:,1,jp_sal) ) * tmask(:,:,1)
245          fsel(:,:,17) = ( emp(:,:)-tsn(:,:,1,jp_tem) ) * tmask(:,:,1)
246          !
247          !         qct(:,:) = 0._wp
248       ENDIF
249    ENDIF
250    !
251    ! Opening of the datrj.out file with the absolute time in day of each dump
252    ! this file gives a record of the dump date for post processing ( ASCII file )
253    !
254    IF(  ( MOD (kt-nit000+1,nwrite) ==  0 )          &
255         &   .OR. ( kt == 1 .AND. ninist == 1 )  ) THEN
256
257       IF( lwp) WRITE(numout,*)'Days since the begining of the run :',adatrj
258
259       !! * U section
260
261       WRITE(clname,9000) TRIM(cexper),'U',iyear,imon,iday
262       cltext=TRIM(cexper)//' U(m/s) '//TRIM(clmode)
263       !
264       IF( ll_dia_inst) THEN   ;   CALL dia_wri_dimg(clname, cltext, un, jpk, 'T')
265       ELSE                    ;   CALL dia_wri_dimg(clname, cltext, um, jpk, 'T')
266       ENDIF
267
268       !! * V section
269
270       WRITE(clname,9000) TRIM(cexper),'V',iyear,imon,iday
271       cltext=TRIM(cexper)//' V(m/s) '//TRIM(clmode)
272       !
273       IF( ll_dia_inst) THEN
274          CALL dia_wri_dimg(clname, cltext, vn, jpk, 'T')
275       ELSE
276          CALL dia_wri_dimg(clname, cltext, vm, jpk, 'T')
277       ENDIF
278       !
279
280       !! * KZ section
281
282       WRITE(clname,9000) TRIM(cexper),'KZ',iyear,imon,iday
283       cltext=TRIM(cexper)//' KZ(m2/s) '//TRIM(clmode)
284
285       IF( ll_dia_inst) THEN
286          CALL dia_wri_dimg(clname, cltext, avt, jpk, 'W')
287       ELSE
288          CALL dia_wri_dimg(clname, cltext, avtm, jpk, 'W')
289       ENDIF
290       !
291
292       !! * W section
293
294       WRITE(clname,9000) TRIM(cexper),'W',iyear,imon,iday
295       cltext=TRIM(cexper)//' W(m/s) '//TRIM(clmode)
296
297       IF( ll_dia_inst) THEN
298          CALL dia_wri_dimg(clname, cltext, wn, jpk, 'W')
299       ELSE
300          CALL dia_wri_dimg(clname, cltext, wm, jpk, 'W')
301       ENDIF
302
303       !! * T section
304
305       WRITE(clname,9000) TRIM(cexper),'T',iyear,imon,iday
306       cltext=TRIM(cexper)//' T (DegC) '//TRIM(clmode)
307
308       IF( ll_dia_inst) THEN
309          CALL dia_wri_dimg(clname, cltext, tsn(:,:,:,jp_tem), jpk, 'T')
310       ELSE
311          CALL dia_wri_dimg(clname, cltext, tm               , jpk, 'T')
312       ENDIF
313       !
314
315       !! * S section
316
317       WRITE(clname,9000) TRIM(cexper),'S',iyear,imon,iday
318       cltext=TRIM(cexper)//' S (PSU) '//TRIM(clmode)
319
320       IF( ll_dia_inst) THEN
321          CALL dia_wri_dimg(clname, cltext, tsn(:,:,:,jp_sal), jpk, 'T')
322       ELSE
323          CALL dia_wri_dimg(clname, cltext, sm               , jpk, 'T')
324       ENDIF
325       !
326
327       !! * 2D section
328
329       WRITE(clname,9000) TRIM(cexper),'2D',iyear,imon,iday
330       cltext='2D fields '//TRIM(clmode)
331
332       IF( ll_dia_inst) THEN
333          CALL dia_wri_dimg(clname, cltext, fsel, inbsel, '2')
334       ELSE
335          CALL dia_wri_dimg(clname, cltext, fsel, inbsel, '2')
336       ENDIF
337
338       IF( lk_mpp )   CALL mppsync   ! synchronization in mpp
339
340       !! * Log message in numout
341
342       IF( lwp)WRITE(numout,*) ' '
343       IF( lwp)WRITE(numout,*) ' **** WRITE in dimg file ',kt
344
345       IF( lwp .AND.        ll_dia_inst) WRITE(numout,*) '    instantaneous fields'
346       IF( lwp .AND. .NOT.  ll_dia_inst) WRITE(numout,*) '    average fields with ',nmoyct,'pdt'
347       !
348       !
349       !! * Reset cumulating arrays  and counter to 0 after writing
350       !
351       IF( .NOT. ll_dia_inst ) THEN
352          nmoyct = 0
353          !
354          um(:,:,:) = 0._wp
355          vm(:,:,:) = 0._wp
356          wm(:,:,:) = 0._wp
357          tm(:,:,:) = 0._wp
358          sm(:,:,:) = 0._wp
359          fsel(:,:,:) = 0._wp
360          avtm(:,:,:) = 0._wp
361       ENDIF
362    ENDIF
363    !
364    IF( nn_timing == 1 )   CALL timing_stop('dia_wri')
365    !
3669000 FORMAT(a,"_",a,"_y",i4.4,"m",i2.2,"d",i2.2,".dimgproc")
367    !
368  END SUBROUTINE dia_wri
Note: See TracBrowser for help on using the repository browser.