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

source: branches/dev_001_SBC/NEMO/OPA_SRC/DIA/diawri_dimg.h90 @ 881

Last change on this file since 881 was 881, checked in by ctlod, 16 years ago

dev_001_SBC: Step I: change cpp ket name key_ice_lim into key_lim2 & change names inside modules with extension _2, see ticket: #110

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 15.6 KB
Line 
1  !!----------------------------------------------------------------------
2  !!                        ***  diawri_dimg.h90  ***
3  !!----------------------------------------------------------------------
4  !!   OPA 9.0 , LOCEAN-IPSL (2005)
5  !! $Id$
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:  utau(:,:) * umask(:,:,1) zonal stress in N.m-2
44    !!  level 2:  vtau(:,:) * vmask(:,:,1) meridional stress in N. m-2
45    !!  level 3:  qsr + qns                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
79    !! * Arguments
80    INTEGER ,INTENT(in) :: kt, kindic
81
82    !! * local declarations
83    INTEGER :: inbsel, jk
84!!  INTEGER :: iwrite
85    INTEGER :: iyear,imon,iday
86    INTEGER, SAVE :: nmoyct
87
88#if defined key_diainstant
89    LOGICAL, PARAMETER :: ll_dia_inst=.TRUE.  !: for instantaneous output
90#else
91    LOGICAL, PARAMETER :: ll_dia_inst=.FALSE. !: for average output
92#endif
93
94    REAL(wp), SAVE, DIMENSION (jpi,jpj,jpk) ::  um , vm   ! used to compute mean u, v fields
95    REAL(wp), SAVE, DIMENSION (jpi,jpj,jpk) ::  wm        ! used to compute mean w fields
96    REAL(wp), SAVE, DIMENSION (jpi,jpj,jpk) ::  avtm      ! used to compute mean kz fields
97    REAL(wp), SAVE, DIMENSION (jpi,jpj,jpk) ::  tm , sm   ! used to compute mean t, s fields
98    REAL(wp), SAVE, DIMENSION (jpi,jpj,jpk) ::  fsel      ! used to compute mean 2d fields
99    REAL(wp) :: zdtj
100    !
101    CHARACTER(LEN=80) :: clname
102    CHARACTER(LEN=80) :: cltext
103    CHARACTER(LEN=80) :: clmode
104    CHARACTER(LEN= 4) :: clver
105    !
106    !  Initialization
107    !  ---------------
108    !
109#ifdef key_diaspr
110    inbsel = 20
111#else
112    inbsel = 17
113#endif
114#if defined key_flx_core
115    inbsel = 23
116#endif
117
118    IF( inbsel >  jpk) THEN
119       IF( lwp) WRITE(numout,*)  &
120            ' STOP inbsel =',inbsel,' is larger than jpk=',jpk
121       STOP
122    ENDIF
123
124
125    iyear = ndastp/10000
126    imon = (ndastp-iyear*10000)/100
127    iday = ndastp - imon*100 - iyear*10000
128
129    !     
130    !! dimg format V1.0 should start with the 4 char. string '@!01'
131    !!
132    clver='@!01'
133    !
134    IF( .NOT. ll_dia_inst ) THEN
135       !
136       !! * Mean output section
137       !! ----------------------
138       !
139       IF( kt == nit000 .AND. lwp ) WRITE(numout,*) &
140            'THE OUTPUT FILES CONTAINS THE AVERAGE OF EACH FIELD'
141       !
142       IF( kt == nit000  ) THEN
143          ! reset arrays for average computation
144          nmoyct = 0
145          !
146          um(:,:,:) = 0._wp
147          vm(:,:,:) = 0._wp
148          wm(:,:,:) = 0._wp
149          avtm(:,:,:) = 0._wp
150          tm(:,:,:) = 0._wp
151          sm(:,:,:) = 0._wp
152          fsel(:,:,:) = 0._wp
153          !
154       ENDIF
155
156       !  cumulate values
157       !  ---------------
158
159       nmoyct = nmoyct+1
160       !
161       um(:,:,:)=um(:,:,:) + un (:,:,:)
162       vm(:,:,:)=vm(:,:,:) + vn (:,:,:)
163       wm(:,:,:)=wm(:,:,:) + wn (:,:,:)
164       avtm(:,:,:)=avtm(:,:,:) + avt (:,:,:)
165       tm(:,:,:)=tm(:,:,:) + tn (:,:,:)
166       sm(:,:,:)=sm(:,:,:) + sn (:,:,:)
167       !
168       fsel(:,:,1 ) = fsel(:,:,1 ) + utau(:,:) * umask(:,:,1)
169       fsel(:,:,2 ) = fsel(:,:,2 ) + vtau(:,:) * vmask(:,:,1)
170       fsel(:,:,3 ) = fsel(:,:,3 ) + qsr (:,:) + qns  (:,:)
171       fsel(:,:,4 ) = fsel(:,:,4 ) + emp (:,:)
172       fsel(:,:,5 ) = fsel(:,:,5 ) + tb  (:,:,1) - sst(:,:)
173#if ! defined key_dynspg_rl
174       fsel(:,:,6 ) = fsel(:,:,6 ) + sshn(:,:)    ! SSH
175#else
176       fsel(:,:,6 ) = fsel(:,:,6 ) + bsfn(:,:)    ! BSF
177#endif
178       fsel(:,:,7 ) = fsel(:,:,7 ) + qsr(:,:)
179       fsel(:,:,8 ) = fsel(:,:,8 ) + qrp (:,:)
180       fsel(:,:,9 ) = fsel(:,:,9 ) + erp (:,:)
181       fsel(:,:,10) = fsel(:,:,10) + hmld(:,:)
182       fsel(:,:,11) = fsel(:,:,11) + hmlp(:,:)
183       fsel(:,:,12) = fsel(:,:,12) + freeze(:,:)
184       fsel(:,:,13) = fsel(:,:,13) + sst(:,:)
185       !        fsel(:,:,14) = fsel(:,:,14) + qct(:,:)
186       !        fsel(:,:,15) = fsel(:,:,15) + fbt(:,:)
187       fsel(:,:,16) = fsel(:,:,16) + emps(:,:)
188#if defined key_lim2
189       fsel(:,:,17) = fsel(:,:,17) + fsalt(:,:)
190#endif
191#ifdef key_diaspr   
192       fsel(:,:,18) = fsel(:,:,18) + gps(:,:)/g
193#endif
194#if defined key_flx_core
195       fsel(:,:,21) = fsel(:,:,21) + qla(:,:)
196       fsel(:,:,22) = fsel(:,:,22) + qlw(:,:)
197       fsel(:,:,23) = fsel(:,:,23) + qsb(:,:)
198#endif
199       !
200       ! Output of dynamics and tracer fields and selected fields (numwri)
201       ! -----------------------------------------------------------------
202       !
203       !
204       zdtj=rdt/86400.   ! time step in days
205       WRITE(clmode,'(f5.1,a)' ) nwrite*zdtj,' days average'
206
207       !       iwrite=NINT(adatrj/rwrite)
208       !      IF (abs(adatrj-iwrite*rwrite) < zdtj/2.      &
209
210       IF(  ( MOD (kt-nit000+1,nwrite) ==  0 )          &
211            &   .OR.       kindic <   0            &
212            &   .OR. ( kt == 1 .AND. kindic > 0)  ) THEN
213          ! it is time to make a dump on file
214          ! compute average
215          um(:,:,:) = um(:,:,:) / nmoyct
216          vm(:,:,:) = vm(:,:,:) / nmoyct
217          wm(:,:,:) = wm(:,:,:) / nmoyct
218          avtm(:,:,:) = avtm(:,:,:) / nmoyct
219          tm(:,:,:) = tm(:,:,:) / nmoyct
220          sm(:,:,:) = sm(:,:,:) / nmoyct
221          !
222          fsel(:,:,:) = fsel(:,:,:) / nmoyct
223          !
224          ! note : the surface pressure is not averaged, but rather
225          ! computed from the averaged gradients.
226          !
227#ifdef key_diaspr
228          fsel(:,:,18)= gps(:,:)/g
229          fsel(:,:,19)= spgu(:,:)
230          fsel(:,:,20)= spgv(:,:)
231#endif
232          ! mask mean field with tmask except utau vtau (1,2)
233          DO jk=3,inbsel
234            fsel(:,:,jk)=fsel(:,:,jk)*tmask(:,:,1)
235          END DO
236       ENDIF
237       !
238    ELSE   ! ll_dia_inst true
239       !
240       !! * Instantaneous output section
241       !! ------------------------------
242       !
243       IF( kt == nit000 .AND. lwp ) WRITE(numout,*) &
244            'THE OUTPUT FILES CONTAINS INSTANTANEOUS VALUES OF EACH FIELD'
245       !
246       zdtj=rdt/86400.   ! time step in days
247       !  iwrite=NINT(adatrj/rwrite)
248       clmode='instantaneous'
249       !     IF (abs(adatrj-iwrite*rwrite) < zdtj/2.  &
250       IF (  ( MOD (kt-nit000+1,nwrite) ==  0 )          &
251            &   .OR.       kindic <   0            &
252            &   .OR. ( kt == 1 .AND. kindic > 0)  ) THEN
253          !
254          ! transfer wp arrays to sp arrays for dimg files
255          fsel(:,:,:) = 0._wp
256          !
257          fsel(:,:,1 ) = utau(:,:) * umask(:,:,1)
258          fsel(:,:,2 ) = vtau(:,:) * vmask(:,:,1)
259          fsel(:,:,3 ) = (qsr (:,:) + qnr (:,:)) * tmask(:,:,1)
260          fsel(:,:,4 ) = emp (:,:) * tmask(:,:,1)
261          fsel(:,:,5 ) = (tb  (:,:,1) -sst(:,:)) *tmask(:,:,1)
262
263#if ! defined key_dynspg_rl
264          fsel(:,:,6 ) = sshn(:,:)
265#else
266          fsel(:,:,6 ) = bsfn(:,:)
267#endif
268          fsel(:,:,7 ) = qsr (:,:) * tmask(:,:,1)
269          fsel(:,:,8 ) = qrp (:,:) * tmask(:,:,1)
270          fsel(:,:,9 ) = erp (:,:) * tmask(:,:,1)
271          fsel(:,:,10) = hmld(:,:) * tmask(:,:,1)
272          fsel(:,:,11) = hmlp(:,:) * tmask(:,:,1)
273          fsel(:,:,12) = freeze(:,:) * tmask(:,:,1)
274          fsel(:,:,13) =  sst(:,:) 
275          !         fsel(:,:,14) =  qct(:,:)
276          !         fsel(:,:,15) =  fbt(:,:)
277          fsel(:,:,16) =  emps(:,:) * tmask(:,:,1)
278#if defined key_lim2
279          fsel(:,:,17) =  fsalt(:,:) * tmask(:,:,1)
280#endif
281#ifdef key_diaspr           
282          fsel(:,:,18) =      gps(:,:) /g
283          fsel(:,:,19) =      spgu(:,:)
284          fsel(:,:,20) =      spgv(:,:)
285#endif
286#if defined key_flx_core
287          fsel(:,:,21) =  qla(:,:)* tmask(:,:,1)
288          fsel(:,:,22) =  qlw(:,:)* tmask(:,:,1)
289          fsel(:,:,23) =  qsb(:,:)* tmask(:,:,1)
290#endif
291          !
292          !         qct(:,:) = 0._wp
293       ENDIF
294    ENDIF
295    !
296    ! Opening of the datrj.out file with the absolute time in day of each dump
297    ! this file gives a record of the dump date for post processing ( ASCII file )
298    !
299    IF(  ( MOD (kt-nit000+1,nwrite) ==  0 )          &
300         &   .OR.       kindic <   0            &
301         &   .OR. ( kt == 1 .AND. kindic > 0)  ) THEN
302
303       IF( lwp) WRITE(numout,*)'Days since the begining of the run :',adatrj
304
305       !! * U section
306
307       WRITE(clname,9000) TRIM(cexper),'U',iyear,imon,iday
308       cltext=TRIM(cexper)//' U(m/s) '//TRIM(clmode)
309       IF ( kindic < 0 )   cltext=TRIM(cexper)//' U(m/s)  instantaneous (explosion)'
310       !
311       IF( ll_dia_inst) THEN
312          CALL dia_wri_dimg(clname, cltext, un, jpk, 'T')
313
314       ELSE
315          IF( kindic ==  -3 ) THEN
316             ! ... in case of explosion on umax, dump instantateous u field instead of mean.
317             CALL dia_wri_dimg(clname, cltext, un, jpk, 'T')
318          ELSE
319             CALL dia_wri_dimg(clname, cltext, um, jpk, 'T')
320          ENDIF
321       ENDIF
322
323       !! * V section
324
325       WRITE(clname,9000) TRIM(cexper),'V',iyear,imon,iday
326       cltext=TRIM(cexper)//' V(m/s) '//TRIM(clmode)
327       !
328       IF( ll_dia_inst) THEN
329          CALL dia_wri_dimg(clname, cltext, vn, jpk, 'T')
330       ELSE
331          CALL dia_wri_dimg(clname, cltext, vm, jpk, 'T')
332       ENDIF
333       !
334
335       !! * KZ section
336
337       WRITE(clname,9000) TRIM(cexper),'KZ',iyear,imon,iday
338       cltext=TRIM(cexper)//' KZ(m2/s) '//TRIM(clmode)
339
340       IF( ll_dia_inst) THEN
341          CALL dia_wri_dimg(clname, cltext, avt, jpk, 'W')
342       ELSE
343          CALL dia_wri_dimg(clname, cltext, avtm, jpk, 'W')
344       ENDIF
345       !
346
347       !! * W section
348
349       WRITE(clname,9000) TRIM(cexper),'W',iyear,imon,iday
350       cltext=TRIM(cexper)//' W(m/s) '//TRIM(clmode)
351
352       IF( ll_dia_inst) THEN
353          CALL dia_wri_dimg(clname, cltext, wn, jpk, 'W')
354       ELSE
355          CALL dia_wri_dimg(clname, cltext, wm, jpk, 'W')
356       ENDIF
357
358       !! * T section
359
360       WRITE(clname,9000) TRIM(cexper),'T',iyear,imon,iday
361       cltext=TRIM(cexper)//' T (DegC) '//TRIM(clmode)
362
363       IF( ll_dia_inst) THEN
364          CALL dia_wri_dimg(clname, cltext, tn, jpk, 'T')
365       ELSE
366          CALL dia_wri_dimg(clname, cltext, tm, jpk, 'T')
367       ENDIF
368       !
369
370       !! * S section
371
372       WRITE(clname,9000) TRIM(cexper),'S',iyear,imon,iday
373       cltext=TRIM(cexper)//' S (PSU) '//TRIM(clmode)
374
375       IF( ll_dia_inst) THEN
376          CALL dia_wri_dimg(clname, cltext, sn, jpk, 'T')
377       ELSE
378          CALL dia_wri_dimg(clname, cltext, sm, jpk, 'T')
379       ENDIF
380       !
381
382       !! * 2D section
383
384       WRITE(clname,9000) TRIM(cexper),'2D',iyear,imon,iday
385       cltext='2D fields '//TRIM(clmode)
386
387       IF( ll_dia_inst) THEN
388          CALL dia_wri_dimg(clname, cltext, fsel, inbsel, '2')
389       ELSE
390          CALL dia_wri_dimg(clname, cltext, fsel, inbsel, '2')
391       ENDIF
392
393       IF( lk_mpp )   CALL mppsync   ! synchronization in mpp
394
395       !! * Log message in numout
396
397       IF( lwp)WRITE(numout,*) ' '
398       IF( lwp)WRITE(numout,*) ' **** WRITE in numwri ',kt
399
400       IF( lwp .AND.        ll_dia_inst) WRITE(numout,*) '    instantaneous fields'
401       IF( lwp .AND. .NOT.  ll_dia_inst) WRITE(numout,*) '    average fields with ',nmoyct,'pdt'
402       !
403       !
404       !! * Reset cumulating arrays  and counter to 0 after writing
405       !
406       IF( .NOT. ll_dia_inst ) THEN
407          nmoyct = 0
408          !
409          um(:,:,:) = 0._wp
410          vm(:,:,:) = 0._wp
411          wm(:,:,:) = 0._wp
412          tm(:,:,:) = 0._wp
413          sm(:,:,:) = 0._wp
414          fsel(:,:,:) = 0._wp
415          avtm(:,:,:) = 0._wp
416       ENDIF
417    ENDIF
418    !
4199000 FORMAT(a,"_",a,"_y",i4.4,"m",i2.2,"d",i2.2,".dimgproc")
420
421  END SUBROUTINE dia_wri
422
423  SUBROUTINE dia_wri_state ( cdfile_name)
424    !!-------------------------------------------------------------------
425    !!        ***     ROUTINE dia_wri_state  ***
426    !!
427    !! ** Purpose :   Dummy routine for compatibility with IOIPSL output
428    !!
429    !! ** History :
430    !!      9.O  ! 03-06  (J.M. Molines ) dimgout
431    !!--------------------------------------------------------------------
432    !! * Arguments
433    CHARACTER (len=*), INTENT(in) ::   cdfile_name   ! name of the file created
434    !!--------------------------------------------------------------------
435
436    IF( lwp) WRITE(numout,*) 'dia_wri_state: Dummy call', cdfile_name
437    IF( lwp) WRITE(numout,*) '-------------'
438    IF( lwp) WRITE(numout,*)
439
440  END SUBROUTINE dia_wri_state
Note: See TracBrowser for help on using the repository browser.