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 @ 719

Last change on this file since 719 was 719, checked in by ctlod, 17 years ago

get back to the nemo_v2_3 version for trunk

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 15.6 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
304       IF( lwp) WRITE(numout,*)'Days since the begining of the run :',adatrj
305
306       !! * U section
307
308       WRITE(clname,9000) TRIM(cexper),'U',iyear,imon,iday
309       cltext=TRIM(cexper)//' U(m/s) '//TRIM(clmode)
310       IF ( kindic < 0 )   cltext=TRIM(cexper)//' U(m/s)  instantaneous (explosion)'
311       !
312       IF( ll_dia_inst) THEN
313          CALL dia_wri_dimg(clname, cltext, un, jpk, 'T')
314
315       ELSE
316          IF( kindic ==  -3 ) THEN
317             ! ... in case of explosion on umax, dump instantateous u field instead of mean.
318             CALL dia_wri_dimg(clname, cltext, un, jpk, 'T')
319          ELSE
320             CALL dia_wri_dimg(clname, cltext, um, jpk, 'T')
321          ENDIF
322       ENDIF
323
324       !! * V section
325
326       WRITE(clname,9000) TRIM(cexper),'V',iyear,imon,iday
327       cltext=TRIM(cexper)//' V(m/s) '//TRIM(clmode)
328       !
329       IF( ll_dia_inst) THEN
330          CALL dia_wri_dimg(clname, cltext, vn, jpk, 'T')
331       ELSE
332          CALL dia_wri_dimg(clname, cltext, vm, jpk, 'T')
333       ENDIF
334       !
335
336       !! * KZ section
337
338       WRITE(clname,9000) TRIM(cexper),'KZ',iyear,imon,iday
339       cltext=TRIM(cexper)//' KZ(m2/s) '//TRIM(clmode)
340
341       IF( ll_dia_inst) THEN
342          CALL dia_wri_dimg(clname, cltext, avt, jpk, 'W')
343       ELSE
344          CALL dia_wri_dimg(clname, cltext, avtm, jpk, 'W')
345       ENDIF
346       !
347
348       !! * W section
349
350       WRITE(clname,9000) TRIM(cexper),'W',iyear,imon,iday
351       cltext=TRIM(cexper)//' W(m/s) '//TRIM(clmode)
352
353       IF( ll_dia_inst) THEN
354          CALL dia_wri_dimg(clname, cltext, wn, jpk, 'W')
355       ELSE
356          CALL dia_wri_dimg(clname, cltext, wm, jpk, 'W')
357       ENDIF
358
359       !! * T section
360
361       WRITE(clname,9000) TRIM(cexper),'T',iyear,imon,iday
362       cltext=TRIM(cexper)//' T (DegC) '//TRIM(clmode)
363
364       IF( ll_dia_inst) THEN
365          CALL dia_wri_dimg(clname, cltext, tn, jpk, 'T')
366       ELSE
367          CALL dia_wri_dimg(clname, cltext, tm, jpk, 'T')
368       ENDIF
369       !
370
371       !! * S section
372
373       WRITE(clname,9000) TRIM(cexper),'S',iyear,imon,iday
374       cltext=TRIM(cexper)//' S (PSU) '//TRIM(clmode)
375
376       IF( ll_dia_inst) THEN
377          CALL dia_wri_dimg(clname, cltext, sn, jpk, 'T')
378       ELSE
379          CALL dia_wri_dimg(clname, cltext, sm, jpk, 'T')
380       ENDIF
381       !
382
383       !! * 2D section
384
385       WRITE(clname,9000) TRIM(cexper),'2D',iyear,imon,iday
386       cltext='2D fields '//TRIM(clmode)
387
388       IF( ll_dia_inst) THEN
389          CALL dia_wri_dimg(clname, cltext, fsel, inbsel, '2')
390       ELSE
391          CALL dia_wri_dimg(clname, cltext, fsel, inbsel, '2')
392       ENDIF
393
394       IF( lk_mpp )   CALL mppsync   ! synchronization in mpp
395
396       !! * Log message in numout
397
398       IF( lwp)WRITE(numout,*) ' '
399       IF( lwp)WRITE(numout,*) ' **** WRITE in numwri ',kt
400
401       IF( lwp .AND.        ll_dia_inst) WRITE(numout,*) '    instantaneous fields'
402       IF( lwp .AND. .NOT.  ll_dia_inst) WRITE(numout,*) '    average fields with ',nmoyct,'pdt'
403       !
404       !
405       !! * Reset cumulating arrays  and counter to 0 after writing
406       !
407       IF( .NOT. ll_dia_inst ) THEN
408          nmoyct = 0
409          !
410          um(:,:,:) = 0._wp
411          vm(:,:,:) = 0._wp
412          wm(:,:,:) = 0._wp
413          tm(:,:,:) = 0._wp
414          sm(:,:,:) = 0._wp
415          fsel(:,:,:) = 0._wp
416          avtm(:,:,:) = 0._wp
417       ENDIF
418    ENDIF
419    !
4209000 FORMAT(a,"_",a,"_y",i4.4,"m",i2.2,"d",i2.2,".dimgproc")
421
422  END SUBROUTINE dia_wri
423
424  SUBROUTINE dia_wri_state ( cdfile_name)
425    !!-------------------------------------------------------------------
426    !!        ***     ROUTINE dia_wri_state  ***
427    !!
428    !! ** Purpose :   Dummy routine for compatibility with IOIPSL output
429    !!
430    !! ** History :
431    !!      9.O  ! 03-06  (J.M. Molines ) dimgout
432    !!--------------------------------------------------------------------
433    !! * Arguments
434    CHARACTER (len=*), INTENT(in) ::   cdfile_name   ! name of the file created
435    !!--------------------------------------------------------------------
436
437    IF( lwp) WRITE(numout,*) 'dia_wri_state: Dummy call', cdfile_name
438    IF( lwp) WRITE(numout,*) '-------------'
439    IF( lwp) WRITE(numout,*)
440
441  END SUBROUTINE dia_wri_state
Note: See TracBrowser for help on using the repository browser.