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/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/OPA_SRC/DIA – NEMO

source: branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/OPA_SRC/DIA/diawri_dimg.h90 @ 2789

Last change on this file since 2789 was 2789, checked in by cetlod, 13 years ago

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