source: branches/UKMO/r6232_tracer_advection/NEMOGCM/NEMO/OPA_SRC/DIA/diawri_dimg.h90 @ 9295

Last change on this file since 9295 was 9295, checked in by jcastill, 3 years ago

Remove svn keywords

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