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

source: branches/2012/dev_r3385_NOCS04_HAMF/NEMOGCM/NEMO/OPA_SRC/DIA/diawri_dimg.h90 @ 3402

Last change on this file since 3402 was 3402, checked in by acc, 12 years ago

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