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

source: trunk/NEMO/OPA_SRC/DIA/diawri_dimg.h90 @ 642

Last change on this file since 642 was 632, checked in by opalod, 17 years ago

nemo_v2_bugfix_026 : CT : -add key_flx_core to save in restart files the nfbulk parameter and the gsst(:,:) field when using CORE forcing

  • save surface fluxes qla, qsb and qlw
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 15.8 KB
Line 
1  !!----------------------------------------------------------------------
2  !!                        ***  diawri_dimg.h90  ***
3  !!----------------------------------------------------------------------
4  !!   OPA 9.0 , LOCEAN-IPSL (2005)
5  !! $Header$
6  !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
7  !!----------------------------------------------------------------------
8
9  SUBROUTINE dia_wri (kt, kindic)
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    !!     kindic is 0 or >0 in normal condition. When < 0 it indicates an error
24    !!     condition and instantaneous file output is forced.
25    !!       Each processor creates its own file with its local data
26    !!     Merging all the files is performed off line by a dedicated program
27    !!
28    !! ** Arguments :
29    !!     kt      : time-step number
30    !!     kindinc :  error condition indicator : >=0 :  OK, < 0 : error.
31    !!
32    !! ** Naming convention for files
33    !!
34    !! {cexper}_{var}_y----m--d--.dimg
35    !!   cexper is the name of the experience, given in the namelist
36    !!   var can be either U, V, T, S, KZ, SSH, ...
37    !!   var can also be 2D, which means that each level of the file is a 2D field as described below
38    !!    y----m--d--  is the date at the time of the dump
39    !!    For mpp output, each processor dumps its own memory, on appropriate record range
40    !!    (direct access : for level jk of a klev field on proc narea irec = 1+ klev*(narea -1) + jk )
41    !!    To be tested with a lot of procs !!!!
42    !!
43    !!  level 1:  taux(:,:) * umask(:,:,1) zonal stress in N.m-2
44    !!  level 2:  tauy(:,:) * vmask(:,:,1) meridional stress in N. m-2
45    !!  level 3:   qt  (:,:)               total heat flux (W/m2)
46    !!  level 4:   emp (:,:)               E-P flux (mm/day)
47    !!  level 5:  tb  (:,:,1)-sst          model SST -forcing sst (degree C)
48    !!  level 6:  bsfb(:,:)         streamfunction (m**3/s)
49    !!  level 7:  qsr (:,:)         solar flux (W/m2)
50    !!  level 8:  qrp (:,:)                relax component of T flux.
51    !!  level 9:  erp (:,:)                relax component of S flux
52    !!  level 10: hmld(:,:)                turbocline depth
53    !!  level 11: hmlp(:,:)                mixed layer depth
54    !!  level 12: freeze (:,:)             Ice cover (1. or 0.)
55    !!  level 13: sst(:,:)                 the observed SST we relax to.
56    !!  level 14: qct(:,:)                 equivalent flux due to treshold SST
57    !!  level 15: fbt(:,:)                 feedback term .
58    !!  level 16: emps(:,:)                concentration/dilution water flux
59    !!  level 17: fsalt(:,:)               Ice=>ocean net freshwater
60    !!  level 18: gps(:,:)                 the surface pressure (m).
61    !!  level 19: spgu(:,:)                the surface pressure gradient in X direction.
62    !!  level 20: spgv(:,:)                the surface pressure gradient in Y direction.
63    !!
64    !! History
65    !!      original  : 91-03 ()
66    !!      additions : 91-11 (G. Madec)
67    !!      additions : 92-06 (M. Imbard) correction restart file
68    !!      additions : 92-07 (M. Imbard) split into diawri and rstwri
69    !!      additions : 93-03 (M. Imbard) suppress writibm
70    !!      additions : 94-12 (M. Imbard) acces direct files
71    !!      additions : 97-2002 ( Clipper Group ) dimg files
72    !!                  dec 2003 ( J.M. Molines) f90, mpp output for OPA9.0
73    !!   9.0  !  05-05  (S. Theetten) add emps fsalt move gps spgu spgv 2 lines below
74    !!   9.0  !  05-11  (V. Garnier) Surface pressure gradient organization
75    !!----------------------------------------------------------------------
76    !! * modules used
77    USE lib_mpp
78    USE dtasst, ONLY : sst
79
80    !! * Arguments
81    INTEGER ,INTENT(in) :: kt, kindic
82
83    !! * local declarations
84    INTEGER :: inbsel, jk
85!!  INTEGER :: iwrite
86    INTEGER :: iyear,imon,iday
87    INTEGER, SAVE :: nmoyct
88
89#if defined key_diainstant
90    LOGICAL, PARAMETER :: ll_dia_inst=.TRUE.  !: for instantaneous output
91#else
92    LOGICAL, PARAMETER :: ll_dia_inst=.FALSE. !: for average output
93#endif
94
95    REAL(wp), SAVE, DIMENSION (jpi,jpj,jpk) ::  um , vm   ! used to compute mean u, v fields
96    REAL(wp), SAVE, DIMENSION (jpi,jpj,jpk) ::  wm        ! used to compute mean w fields
97    REAL(wp), SAVE, DIMENSION (jpi,jpj,jpk) ::  avtm      ! used to compute mean kz fields
98    REAL(wp), SAVE, DIMENSION (jpi,jpj,jpk) ::  tm , sm   ! used to compute mean t, s fields
99    REAL(wp), SAVE, DIMENSION (jpi,jpj,jpk) ::  fsel      ! used to compute mean 2d fields
100    REAL(wp) :: zdtj
101    !
102    CHARACTER(LEN=80) :: clname
103    CHARACTER(LEN=80) :: cltext
104    CHARACTER(LEN=80) :: clmode
105    CHARACTER(LEN= 4) :: clver
106    !
107    !  Initialization
108    !  ---------------
109    !
110#ifdef key_diaspr
111    inbsel = 20
112#else
113    inbsel = 17
114#endif
115#if defined key_flx_core
116    inbsel = 23
117#endif
118
119    IF( inbsel >  jpk) THEN
120       IF( lwp) WRITE(numout,*)  &
121            ' STOP inbsel =',inbsel,' is larger than jpk=',jpk
122       STOP
123    ENDIF
124
125
126    iyear = ndastp/10000
127    imon = (ndastp-iyear*10000)/100
128    iday = ndastp - imon*100 - iyear*10000
129
130    !     
131    !! dimg format V1.0 should start with the 4 char. string '@!01'
132    !!
133    clver='@!01'
134    !
135    IF( .NOT. ll_dia_inst ) THEN
136       !
137       !! * Mean output section
138       !! ----------------------
139       !
140       IF( kt == nit000 .AND. lwp ) WRITE(numout,*) &
141            'THE OUTPUT FILES CONTAINS THE AVERAGE OF EACH FIELD'
142       !
143       IF( kt == nit000  ) THEN
144          ! reset arrays for average computation
145          nmoyct = 0
146          !
147          um(:,:,:) = 0._wp
148          vm(:,:,:) = 0._wp
149          wm(:,:,:) = 0._wp
150          avtm(:,:,:) = 0._wp
151          tm(:,:,:) = 0._wp
152          sm(:,:,:) = 0._wp
153          fsel(:,:,:) = 0._wp
154          !
155       ENDIF
156
157       !  cumulate values
158       !  ---------------
159
160       nmoyct = nmoyct+1
161       !
162       um(:,:,:)=um(:,:,:) + un (:,:,:)
163       vm(:,:,:)=vm(:,:,:) + vn (:,:,:)
164       wm(:,:,:)=wm(:,:,:) + wn (:,:,:)
165       avtm(:,:,:)=avtm(:,:,:) + avt (:,:,:)
166       tm(:,:,:)=tm(:,:,:) + tn (:,:,:)
167       sm(:,:,:)=sm(:,:,:) + sn (:,:,:)
168       !
169       fsel(:,:,1 ) = fsel(:,:,1 ) + taux(:,:) * umask(:,:,1)
170       fsel(:,:,2 ) = fsel(:,:,2 ) + tauy(:,:) * vmask(:,:,1)
171       fsel(:,:,3 ) = fsel(:,:,3 ) + qt  (:,:)
172       fsel(:,:,4 ) = fsel(:,:,4 ) + emp (:,:)
173       fsel(:,:,5 ) = fsel(:,:,5 ) + tb  (:,:,1) - sst(:,:)
174#if ! defined key_dynspg_rl
175       fsel(:,:,6 ) = fsel(:,:,6 ) + sshn(:,:)    ! SSH
176#else
177       fsel(:,:,6 ) = fsel(:,:,6 ) + bsfn(:,:)    ! BSF
178#endif
179       fsel(:,:,7 ) = fsel(:,:,7 ) + qsr(:,:)
180       fsel(:,:,8 ) = fsel(:,:,8 ) + qrp (:,:)
181       fsel(:,:,9 ) = fsel(:,:,9 ) + erp (:,:)
182       fsel(:,:,10) = fsel(:,:,10) + hmld(:,:)
183       fsel(:,:,11) = fsel(:,:,11) + hmlp(:,:)
184       fsel(:,:,12) = fsel(:,:,12) + freeze(:,:)
185       fsel(:,:,13) = fsel(:,:,13) + sst(:,:)
186       !        fsel(:,:,14) = fsel(:,:,14) + qct(:,:)
187       !        fsel(:,:,15) = fsel(:,:,15) + fbt(:,:)
188       fsel(:,:,16) = fsel(:,:,16) + emps(:,:)
189#if defined key_ice_lim
190       fsel(:,:,17) = fsel(:,:,17) + fsalt(:,:)
191#endif
192#ifdef key_diaspr   
193       fsel(:,:,18) = fsel(:,:,18) + gps(:,:)/g
194#endif
195#if defined key_flx_core
196       fsel(:,:,21) = fsel(:,:,21) + qla(:,:)
197       fsel(:,:,22) = fsel(:,:,22) + qlw(:,:)
198       fsel(:,:,23) = fsel(:,:,23) + qsb(:,:)
199#endif
200       !
201       ! Output of dynamics and tracer fields and selected fields (numwri)
202       ! -----------------------------------------------------------------
203       !
204       !
205       zdtj=rdt/86400.   ! time step in days
206       WRITE(clmode,'(f5.1,a)' ) nwrite*zdtj,' days average'
207
208       !       iwrite=NINT(adatrj/rwrite)
209       !      IF (abs(adatrj-iwrite*rwrite) < zdtj/2.      &
210
211       IF(  ( MOD (kt-nit000+1,nwrite) ==  0 )          &
212            &   .OR.       kindic <   0            &
213            &   .OR. ( kt == 1 .AND. kindic > 0)  ) THEN
214          ! it is time to make a dump on file
215          ! compute average
216          um(:,:,:) = um(:,:,:) / nmoyct
217          vm(:,:,:) = vm(:,:,:) / nmoyct
218          wm(:,:,:) = wm(:,:,:) / nmoyct
219          avtm(:,:,:) = avtm(:,:,:) / nmoyct
220          tm(:,:,:) = tm(:,:,:) / nmoyct
221          sm(:,:,:) = sm(:,:,:) / nmoyct
222          !
223          fsel(:,:,:) = fsel(:,:,:) / nmoyct
224          !
225          ! note : the surface pressure is not averaged, but rather
226          ! computed from the averaged gradients.
227          !
228#ifdef key_diaspr
229          fsel(:,:,18)= gps(:,:)/g
230          fsel(:,:,19)= spgu(:,:)
231          fsel(:,:,20)= spgv(:,:)
232#endif
233          ! mask mean field with tmask except taux tauy (1,2)
234          DO jk=3,inbsel
235            fsel(:,:,jk)=fsel(:,:,jk)*tmask(:,:,1)
236          END DO
237       ENDIF
238       !
239    ELSE   ! ll_dia_inst true
240       !
241       !! * Instantaneous output section
242       !! ------------------------------
243       !
244       IF( kt == nit000 .AND. lwp ) WRITE(numout,*) &
245            'THE OUTPUT FILES CONTAINS INSTANTANEOUS VALUES OF EACH FIELD'
246       !
247       zdtj=rdt/86400.   ! time step in days
248       !  iwrite=NINT(adatrj/rwrite)
249       clmode='instantaneous'
250       !     IF (abs(adatrj-iwrite*rwrite) < zdtj/2.  &
251       IF (  ( MOD (kt-nit000+1,nwrite) ==  0 )          &
252            &   .OR.       kindic <   0            &
253            &   .OR. ( kt == 1 .AND. kindic > 0)  ) THEN
254          !
255          ! transfer wp arrays to sp arrays for dimg files
256          fsel(:,:,:) = 0._wp
257          !
258          fsel(:,:,1 ) = taux(:,:) * umask(:,:,1)
259          fsel(:,:,2 ) = tauy(:,:) * vmask(:,:,1)
260          fsel(:,:,3 ) = qt  (:,:) * tmask(:,:,1)
261          fsel(:,:,4 ) = emp (:,:) * tmask(:,:,1)
262          fsel(:,:,5 ) = (tb  (:,:,1) -sst(:,:)) *tmask(:,:,1)
263
264#if ! defined key_dynspg_rl
265          fsel(:,:,6 ) = sshn(:,:)
266#else
267          fsel(:,:,6 ) = bsfn(:,:)
268#endif
269          fsel(:,:,7 ) = qsr (:,:) * tmask(:,:,1)
270          fsel(:,:,8 ) = qrp (:,:) * tmask(:,:,1)
271          fsel(:,:,9 ) = erp (:,:) * tmask(:,:,1)
272          fsel(:,:,10) = hmld(:,:) * tmask(:,:,1)
273          fsel(:,:,11) = hmlp(:,:) * tmask(:,:,1)
274          fsel(:,:,12) = freeze(:,:) * tmask(:,:,1)
275          fsel(:,:,13) =  sst(:,:) 
276          !         fsel(:,:,14) =  qct(:,:)
277          !         fsel(:,:,15) =  fbt(:,:)
278          fsel(:,:,16) =  emps(:,:) * tmask(:,:,1)
279#if defined key_ice_lim
280          fsel(:,:,17) =  fsalt(:,:) * tmask(:,:,1)
281#endif
282#ifdef key_diaspr           
283          fsel(:,:,18) =      gps(:,:) /g
284          fsel(:,:,19) =      spgu(:,:)
285          fsel(:,:,20) =      spgv(:,:)
286#endif
287#if defined key_flx_core
288          fsel(:,:,21) =  qla(:,:)* tmask(:,:,1)
289          fsel(:,:,22) =  qlw(:,:)* tmask(:,:,1)
290          fsel(:,:,23) =  qsb(:,:)* tmask(:,:,1)
291#endif
292          !
293          !         qct(:,:) = 0._wp
294       ENDIF
295    ENDIF
296    !
297    ! Opening of the datrj.out file with the absolute time in day of each dump
298    ! this file gives a record of the dump date for post processing ( ASCII file )
299    !
300    IF(  ( MOD (kt-nit000+1,nwrite) ==  0 )          &
301         &   .OR.       kindic <   0            &
302         &   .OR. ( kt == 1 .AND. kindic > 0)  ) THEN
303       OPEN (14,FILE='datrj.out',FORM='FORMATTED', STATUS='UNKNOWN',POSITION='APPEND ')
304
305       IF( lwp) WRITE(14,'(f10.4,1x,i8)') adatrj, ndastp
306       CLOSE(14)
307
308       IF( lwp) WRITE(numout,*)'Days since the begining of the run :',adatrj
309
310       !! * U section
311
312       WRITE(clname,9000) TRIM(cexper),'U',iyear,imon,iday
313       cltext=TRIM(cexper)//' U(m/s) '//TRIM(clmode)
314       IF ( kindic < 0 )   cltext=TRIM(cexper)//' U(m/s)  instantaneous (explosion)'
315       !
316       IF( ll_dia_inst) THEN
317          CALL dia_wri_dimg(clname, cltext, un, jpk, 'T')
318
319       ELSE
320          IF( kindic ==  -3 ) THEN
321             ! ... in case of explosion on umax, dump instantateous u field instead of mean.
322             CALL dia_wri_dimg(clname, cltext, un, jpk, 'T')
323          ELSE
324             CALL dia_wri_dimg(clname, cltext, um, jpk, 'T')
325          ENDIF
326       ENDIF
327
328       !! * V section
329
330       WRITE(clname,9000) TRIM(cexper),'V',iyear,imon,iday
331       cltext=TRIM(cexper)//' V(m/s) '//TRIM(clmode)
332       !
333       IF( ll_dia_inst) THEN
334          CALL dia_wri_dimg(clname, cltext, vn, jpk, 'T')
335       ELSE
336          CALL dia_wri_dimg(clname, cltext, vm, jpk, 'T')
337       ENDIF
338       !
339
340       !! * KZ section
341
342       WRITE(clname,9000) TRIM(cexper),'KZ',iyear,imon,iday
343       cltext=TRIM(cexper)//' KZ(m2/s) '//TRIM(clmode)
344
345       IF( ll_dia_inst) THEN
346          CALL dia_wri_dimg(clname, cltext, avt, jpk, 'W')
347       ELSE
348          CALL dia_wri_dimg(clname, cltext, avtm, jpk, 'W')
349       ENDIF
350       !
351
352       !! * W section
353
354       WRITE(clname,9000) TRIM(cexper),'W',iyear,imon,iday
355       cltext=TRIM(cexper)//' W(m/s) '//TRIM(clmode)
356
357       IF( ll_dia_inst) THEN
358          CALL dia_wri_dimg(clname, cltext, wn, jpk, 'W')
359       ELSE
360          CALL dia_wri_dimg(clname, cltext, wm, jpk, 'W')
361       ENDIF
362
363       !! * T section
364
365       WRITE(clname,9000) TRIM(cexper),'T',iyear,imon,iday
366       cltext=TRIM(cexper)//' T (DegC) '//TRIM(clmode)
367
368       IF( ll_dia_inst) THEN
369          CALL dia_wri_dimg(clname, cltext, tn, jpk, 'T')
370       ELSE
371          CALL dia_wri_dimg(clname, cltext, tm, jpk, 'T')
372       ENDIF
373       !
374
375       !! * S section
376
377       WRITE(clname,9000) TRIM(cexper),'S',iyear,imon,iday
378       cltext=TRIM(cexper)//' S (PSU) '//TRIM(clmode)
379
380       IF( ll_dia_inst) THEN
381          CALL dia_wri_dimg(clname, cltext, sn, jpk, 'T')
382       ELSE
383          CALL dia_wri_dimg(clname, cltext, sm, jpk, 'T')
384       ENDIF
385       !
386
387       !! * 2D section
388
389       WRITE(clname,9000) TRIM(cexper),'2D',iyear,imon,iday
390       cltext='2D fields '//TRIM(clmode)
391
392       IF( ll_dia_inst) THEN
393          CALL dia_wri_dimg(clname, cltext, fsel, inbsel, '2')
394       ELSE
395          CALL dia_wri_dimg(clname, cltext, fsel, inbsel, '2')
396       ENDIF
397
398       IF( lk_mpp )   CALL mppsync   ! synchronization in mpp
399
400       !! * Log message in numout
401
402       IF( lwp)WRITE(numout,*) ' '
403       IF( lwp)WRITE(numout,*) ' **** WRITE in numwri ',kt
404
405       IF( lwp .AND.        ll_dia_inst) WRITE(numout,*) '    instantaneous fields'
406       IF( lwp .AND. .NOT.  ll_dia_inst) WRITE(numout,*) '    average fields with ',nmoyct,'pdt'
407       !
408       !
409       !! * Reset cumulating arrays  and counter to 0 after writing
410       !
411       IF( .NOT. ll_dia_inst ) THEN
412          nmoyct = 0
413          !
414          um(:,:,:) = 0._wp
415          vm(:,:,:) = 0._wp
416          wm(:,:,:) = 0._wp
417          tm(:,:,:) = 0._wp
418          sm(:,:,:) = 0._wp
419          fsel(:,:,:) = 0._wp
420          avtm(:,:,:) = 0._wp
421       ENDIF
422    ENDIF
423    !
4249000 FORMAT(a,"_",a,"_y",i4.4,"m",i2.2,"d",i2.2,".dimgproc")
425
426  END SUBROUTINE dia_wri
427
428  SUBROUTINE dia_wri_state ( cdfile_name)
429    !!-------------------------------------------------------------------
430    !!        ***     ROUTINE dia_wri_state  ***
431    !!
432    !! ** Purpose :   Dummy routine for compatibility with IOIPSL output
433    !!
434    !! ** History :
435    !!      9.O  ! 03-06  (J.M. Molines ) dimgout
436    !!--------------------------------------------------------------------
437    !! * Arguments
438    CHARACTER (len=*), INTENT(in) ::   cdfile_name   ! name of the file created
439    !!--------------------------------------------------------------------
440
441    IF( lwp) WRITE(numout,*) 'dia_wri_state: Dummy call', cdfile_name
442    IF( lwp) WRITE(numout,*) '-------------'
443    IF( lwp) WRITE(numout,*)
444
445  END SUBROUTINE dia_wri_state
Note: See TracBrowser for help on using the repository browser.