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/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/DIA – NEMO

source: branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/DIA/diawri_dimg.h90 @ 6736

Last change on this file since 6736 was 6736, checked in by jamesharle, 8 years ago

FASTNEt code modifications

  • Property svn:keywords set to Id
File size: 13.8 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    INTEGER :: ialloc
85    REAL(wp) :: zdtj
86    CHARACTER(LEN=80) :: clname
87    CHARACTER(LEN=80) :: cltext
88    CHARACTER(LEN=80) :: clmode
89    CHARACTER(LEN= 4) :: clver
90    !!----------------------------------------------------------------------
91    IF( nn_timing == 1 )   CALL timing_start('dia_wri')
92    !
93    !  Initialization
94    !  ---------------
95    !
96    IF( .NOT. ALLOCATED(um) )THEN
97       ALLOCATE(um(jpi,jpj,jpk), vm(jpi,jpj,jpk), &
98                wm(jpi,jpj,jpk),                  &
99                avtm(jpi,jpj,jpk),                &
100                tm(jpi,jpj,jpk), sm(jpi,jpj,jpk), &
101                fsel(jpi,jpj,jpk),                &
102                STAT=ialloc )
103       !
104       IF( lk_mpp      )   CALL mpp_sum ( ialloc  )
105       IF( ialloc /= 0 )   CALL ctl_warn('dia_wri( diawri_dimg.h90) : failed to allocate arrays')
106    ENDIF
107
108
109    inbsel = 17
110
111    IF( inbsel >  jpk ) THEN
112       IF(lwp) WRITE(numout,*)  ' STOP inbsel =',inbsel,' is larger than jpk=',jpk
113       STOP
114    ENDIF
115
116    iyear = ndastp/10000
117    imon = (ndastp-iyear*10000)/100
118    iday = ndastp - imon*100 - iyear*10000
119
120    !     
121    !! dimg format V1.0 should start with the 4 char. string '@!01'
122    !!
123    clver='@!01'
124    !
125    IF( .NOT. ll_dia_inst ) THEN
126       !
127       !! * Mean output section
128       !! ----------------------
129       !
130       IF( kt == nit000 .AND. lwp ) WRITE(numout,*) &
131            'THE OUTPUT FILES CONTAINS THE AVERAGE OF EACH FIELD'
132       !
133       IF( kt == nit000  ) THEN
134          ! reset arrays for average computation
135          nmoyct = 0
136          !
137          um(:,:,:) = 0._wp
138          vm(:,:,:) = 0._wp
139          wm(:,:,:) = 0._wp
140          avtm(:,:,:) = 0._wp
141          tm(:,:,:) = 0._wp
142          sm(:,:,:) = 0._wp
143          fsel(:,:,:) = 0._wp
144          !
145       ENDIF
146
147       !  cumulate values
148       !  ---------------
149
150       nmoyct = nmoyct+1
151       !
152       um(:,:,:)=um(:,:,:) + un (:,:,:)
153       vm(:,:,:)=vm(:,:,:) + vn (:,:,:)
154       wm(:,:,:)=wm(:,:,:) + wn (:,:,:)
155       avtm(:,:,:)=avtm(:,:,:) + avt (:,:,:)
156       tm(:,:,:)=tm(:,:,:) + tsn(:,:,:,jp_tem)
157       sm(:,:,:)=sm(:,:,:) + tsn(:,:,:,jp_sal)
158       !
159       fsel(:,:,1 ) = fsel(:,:,1 ) + utau(:,:) * umask(:,:,1)
160       fsel(:,:,2 ) = fsel(:,:,2 ) + vtau(:,:) * vmask(:,:,1)
161       fsel(:,:,3 ) = fsel(:,:,3 ) + qsr (:,:) + qns  (:,:)
162       fsel(:,:,4 ) = fsel(:,:,4 ) + ( emp(:,:)-rnf(:,:) )
163       !        fsel(:,:,5 ) = fsel(:,:,5 ) + tsb(:,:,1,jp_tem)  !RB not used
164       fsel(:,:,6 ) = fsel(:,:,6 ) + sshn(:,:)
165       fsel(:,:,7 ) = fsel(:,:,7 ) + qsr(:,:)
166       IF( ln_ssr ) THEN
167          IF( nn_sstr /= 0 )   fsel(:,:,8 ) = fsel(:,:,8 ) + qrp (:,:)
168          IF( nn_sssr /= 0 )   fsel(:,:,9 ) = fsel(:,:,9 ) + erp (:,:)
169       ENDIF
170       fsel(:,:,10) = fsel(:,:,10) + hmld(:,:)
171       fsel(:,:,11) = fsel(:,:,11) + hmlp(:,:)
172       fsel(:,:,12) = fsel(:,:,12) + fr_i(:,:)
173       !        fsel(:,:,13) = fsel(:,:,13)   !RB not used
174       !        fsel(:,:,14) = fsel(:,:,14) + qct(:,:)
175       !        fsel(:,:,15) = fsel(:,:,15) + fbt(:,:)
176       fsel(:,:,16) = fsel(:,:,16) + ( emps(:,:)-rnf(:,:) )
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          IF( ln_ssr ) THEN
237             IF( nn_sstr /= 0 )   fsel(:,:,8 ) = qrp (:,:) * tmask(:,:,1)
238             IF( nn_sssr /= 0 )   fsel(:,:,9 ) = erp (:,:) * tmask(:,:,1)
239          ENDIF
240          fsel(:,:,10) = hmld(:,:) * tmask(:,:,1)
241          fsel(:,:,11) = hmlp(:,:) * tmask(:,:,1)
242          fsel(:,:,12) = fr_i(:,:) * tmask(:,:,1)
243          !         fsel(:,:,13) = sf_sst(1)%fnow(:,:) !RB not used
244          !         fsel(:,:,14) =  qct(:,:)
245          !         fsel(:,:,15) =  fbt(:,:)
246          fsel(:,:,16) = ( emps(:,:)-rnf(:,:) ) * tmask(:,:,1)
247          !
248          !         qct(:,:) = 0._wp
249       ENDIF
250    ENDIF
251    !
252    ! Opening of the datrj.out file with the absolute time in day of each dump
253    ! this file gives a record of the dump date for post processing ( ASCII file )
254    !
255    IF(  ( MOD (kt-nit000+1,nwrite) ==  0 )          &
256         &   .OR. ( kt == 1 .AND. ninist == 1 )  ) THEN
257
258       IF( lwp) WRITE(numout,*)'Days since the begining of the run :',adatrj
259
260       !! * U section
261
262       WRITE(clname,9000) TRIM(cexper),'U',iyear,imon,iday
263       cltext=TRIM(cexper)//' U(m/s) '//TRIM(clmode)
264       !
265       IF( ll_dia_inst) THEN   ;   CALL dia_wri_dimg(clname, cltext, un, jpk, 'T')
266       ELSE                    ;   CALL dia_wri_dimg(clname, cltext, um, jpk, 'T')
267       ENDIF
268
269       !! * V section
270
271       WRITE(clname,9000) TRIM(cexper),'V',iyear,imon,iday
272       cltext=TRIM(cexper)//' V(m/s) '//TRIM(clmode)
273       !
274       IF( ll_dia_inst) THEN
275          CALL dia_wri_dimg(clname, cltext, vn, jpk, 'T')
276       ELSE
277          CALL dia_wri_dimg(clname, cltext, vm, jpk, 'T')
278       ENDIF
279       !
280
281       !! * KZ section
282
283       WRITE(clname,9000) TRIM(cexper),'KZ',iyear,imon,iday
284       cltext=TRIM(cexper)//' KZ(m2/s) '//TRIM(clmode)
285
286       IF( ll_dia_inst) THEN
287          CALL dia_wri_dimg(clname, cltext, avt, jpk, 'W')
288       ELSE
289          CALL dia_wri_dimg(clname, cltext, avtm, jpk, 'W')
290       ENDIF
291       !
292
293       !! * W section
294
295       WRITE(clname,9000) TRIM(cexper),'W',iyear,imon,iday
296       cltext=TRIM(cexper)//' W(m/s) '//TRIM(clmode)
297
298       IF( ll_dia_inst) THEN
299          CALL dia_wri_dimg(clname, cltext, wn, jpk, 'W')
300       ELSE
301          CALL dia_wri_dimg(clname, cltext, wm, jpk, 'W')
302       ENDIF
303
304       !! * T section
305
306       WRITE(clname,9000) TRIM(cexper),'T',iyear,imon,iday
307       cltext=TRIM(cexper)//' T (DegC) '//TRIM(clmode)
308
309       IF( ll_dia_inst) THEN
310          CALL dia_wri_dimg(clname, cltext, tsn(:,:,:,jp_tem), jpk, 'T')
311       ELSE
312          CALL dia_wri_dimg(clname, cltext, tm               , jpk, 'T')
313       ENDIF
314       !
315
316       !! * S section
317
318       WRITE(clname,9000) TRIM(cexper),'S',iyear,imon,iday
319       cltext=TRIM(cexper)//' S (PSU) '//TRIM(clmode)
320
321       IF( ll_dia_inst) THEN
322          CALL dia_wri_dimg(clname, cltext, tsn(:,:,:,jp_sal), jpk, 'T')
323       ELSE
324          CALL dia_wri_dimg(clname, cltext, sm               , jpk, 'T')
325       ENDIF
326       !
327
328       !! * 2D section
329
330       WRITE(clname,9000) TRIM(cexper),'2D',iyear,imon,iday
331       cltext='2D fields '//TRIM(clmode)
332
333       IF( ll_dia_inst) THEN
334          CALL dia_wri_dimg(clname, cltext, fsel, inbsel, '2')
335       ELSE
336          CALL dia_wri_dimg(clname, cltext, fsel, inbsel, '2')
337       ENDIF
338
339       IF( lk_mpp )   CALL mppsync   ! synchronization in mpp
340
341       !! * Log message in numout
342
343       IF( lwp)WRITE(numout,*) ' '
344       IF( lwp)WRITE(numout,*) ' **** WRITE in dimg file ',kt
345
346       IF( lwp .AND.        ll_dia_inst) WRITE(numout,*) '    instantaneous fields'
347       IF( lwp .AND. .NOT.  ll_dia_inst) WRITE(numout,*) '    average fields with ',nmoyct,'pdt'
348       !
349       !
350       !! * Reset cumulating arrays  and counter to 0 after writing
351       !
352       IF( .NOT. ll_dia_inst ) THEN
353          nmoyct = 0
354          !
355          um(:,:,:) = 0._wp
356          vm(:,:,:) = 0._wp
357          wm(:,:,:) = 0._wp
358          tm(:,:,:) = 0._wp
359          sm(:,:,:) = 0._wp
360          fsel(:,:,:) = 0._wp
361          avtm(:,:,:) = 0._wp
362       ENDIF
363    ENDIF
364    !
365    IF( nn_timing == 1 )   CALL timing_stop('dia_wri')
366    !
3679000 FORMAT(a,"_",a,"_y",i4.4,"m",i2.2,"d",i2.2,".dimgproc")
368    !
369  END SUBROUTINE dia_wri
Note: See TracBrowser for help on using the repository browser.