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

Last change on this file since 1528 was 1528, checked in by rblod, 15 years ago

Suppress rigid-lid option, see ticket #486
  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 15.1 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) ! deprecated
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: fr_i(:,:)                ice fraction (between 0 and 1)
55    !!  level 13: sst(:,:)                 the observed SST we relax to. ! deprecated
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)  !RB not used
173       fsel(:,:,6 ) = fsel(:,:,6 ) + sshn(:,:)
174       fsel(:,:,7 ) = fsel(:,:,7 ) + qsr(:,:)
175       fsel(:,:,8 ) = fsel(:,:,8 ) + qrp (:,:)
176       fsel(:,:,9 ) = fsel(:,:,9 ) + erp (:,:)
177       fsel(:,:,10) = fsel(:,:,10) + hmld(:,:)
178       fsel(:,:,11) = fsel(:,:,11) + hmlp(:,:)
179       fsel(:,:,12) = fsel(:,:,12) + fr_i(:,:)
180       !        fsel(:,:,13) = fsel(:,:,13)   !RB not used
181       !        fsel(:,:,14) = fsel(:,:,14) + qct(:,:)
182       !        fsel(:,:,15) = fsel(:,:,15) + fbt(:,:)
183       fsel(:,:,16) = fsel(:,:,16) + emps(:,:)
184#ifdef key_diaspr   
185       fsel(:,:,18) = fsel(:,:,18) + gps(:,:)/g
186#endif
187       !
188       ! Output of dynamics and tracer fields and selected fields (numwri)
189       ! -----------------------------------------------------------------
190       !
191       !
192       zdtj=rdt/86400.   ! time step in days
193       WRITE(clmode,'(f5.1,a)' ) nwrite*zdtj,' days average'
194
195       !       iwrite=NINT(adatrj/rwrite)
196       !      IF (abs(adatrj-iwrite*rwrite) < zdtj/2.      &
197
198       IF(  ( MOD (kt-nit000+1,nwrite) ==  0 )          &
199            &   .OR.       kindic <   0            &
200            &   .OR. ( kt == 1 .AND. kindic > 0)  ) THEN
201          ! it is time to make a dump on file
202          ! compute average
203          um(:,:,:) = um(:,:,:) / nmoyct
204          vm(:,:,:) = vm(:,:,:) / nmoyct
205          wm(:,:,:) = wm(:,:,:) / nmoyct
206          avtm(:,:,:) = avtm(:,:,:) / nmoyct
207          tm(:,:,:) = tm(:,:,:) / nmoyct
208          sm(:,:,:) = sm(:,:,:) / nmoyct
209          !
210          fsel(:,:,:) = fsel(:,:,:) / nmoyct
211          !
212          ! note : the surface pressure is not averaged, but rather
213          ! computed from the averaged gradients.
214          !
215#ifdef key_diaspr
216          fsel(:,:,18)= gps(:,:)/g
217          fsel(:,:,19)= spgu(:,:)
218          fsel(:,:,20)= spgv(:,:)
219#endif
220          ! mask mean field with tmask except utau vtau (1,2)
221          DO jk=3,inbsel
222            fsel(:,:,jk)=fsel(:,:,jk)*tmask(:,:,1)
223          END DO
224       ENDIF
225       !
226    ELSE   ! ll_dia_inst true
227       !
228       !! * Instantaneous output section
229       !! ------------------------------
230       !
231       IF( kt == nit000 .AND. lwp ) WRITE(numout,*) &
232            'THE OUTPUT FILES CONTAINS INSTANTANEOUS VALUES OF EACH FIELD'
233       !
234       zdtj=rdt/86400.   ! time step in days
235       !  iwrite=NINT(adatrj/rwrite)
236       clmode='instantaneous'
237       !     IF (abs(adatrj-iwrite*rwrite) < zdtj/2.  &
238       IF (  ( MOD (kt-nit000+1,nwrite) ==  0 )          &
239            &   .OR.       kindic <   0            &
240            &   .OR. ( kt == 1 .AND. kindic > 0)  ) THEN
241          !
242          ! transfer wp arrays to sp arrays for dimg files
243          fsel(:,:,:) = 0._wp
244          !
245          fsel(:,:,1 ) = utau(:,:) * umask(:,:,1)
246          fsel(:,:,2 ) = vtau(:,:) * vmask(:,:,1)
247          fsel(:,:,3 ) = (qsr (:,:) + qns (:,:)) * tmask(:,:,1)
248          fsel(:,:,4 ) = emp (:,:) * tmask(:,:,1)
249          !         fsel(:,:,5 ) = (tb  (:,:,1) - sf_sst(1)%fnow(:,:) ) *tmask(:,:,1) !RB not used
250
251          fsel(:,:,6 ) = sshn(:,:)
252          fsel(:,:,7 ) = qsr (:,:) * tmask(:,:,1)
253          fsel(:,:,8 ) = qrp (:,:) * tmask(:,:,1)
254          fsel(:,:,9 ) = erp (:,:) * tmask(:,:,1)
255          fsel(:,:,10) = hmld(:,:) * tmask(:,:,1)
256          fsel(:,:,11) = hmlp(:,:) * tmask(:,:,1)
257          fsel(:,:,12) = fr_i(:,:) * tmask(:,:,1)
258          !         fsel(:,:,13) = sf_sst(1)%fnow(:,:) !RB not used
259          !         fsel(:,:,14) =  qct(:,:)
260          !         fsel(:,:,15) =  fbt(:,:)
261          fsel(:,:,16) =  emps(:,:) * tmask(:,:,1)
262#ifdef key_diaspr           
263          fsel(:,:,18) =      gps(:,:) /g
264          fsel(:,:,19) =      spgu(:,:)
265          fsel(:,:,20) =      spgv(:,:)
266#endif
267          !
268          !         qct(:,:) = 0._wp
269       ENDIF
270    ENDIF
271    !
272    ! Opening of the datrj.out file with the absolute time in day of each dump
273    ! this file gives a record of the dump date for post processing ( ASCII file )
274    !
275    IF(  ( MOD (kt-nit000+1,nwrite) ==  0 )          &
276         &   .OR.       kindic <   0            &
277         &   .OR. ( kt == 1 .AND. kindic > 0)  ) THEN
278
279       IF( lwp) WRITE(numout,*)'Days since the begining of the run :',adatrj
280
281       !! * U section
282
283       WRITE(clname,9000) TRIM(cexper),'U',iyear,imon,iday
284       cltext=TRIM(cexper)//' U(m/s) '//TRIM(clmode)
285       IF ( kindic < 0 )   cltext=TRIM(cexper)//' U(m/s)  instantaneous (explosion)'
286       !
287       IF( ll_dia_inst) THEN
288          CALL dia_wri_dimg(clname, cltext, un, jpk, 'T')
289
290       ELSE
291          IF( kindic ==  -3 ) THEN
292             ! ... in case of explosion on umax, dump instantateous u field instead of mean.
293             CALL dia_wri_dimg(clname, cltext, un, jpk, 'T')
294          ELSE
295             CALL dia_wri_dimg(clname, cltext, um, jpk, 'T')
296          ENDIF
297       ENDIF
298
299       !! * V section
300
301       WRITE(clname,9000) TRIM(cexper),'V',iyear,imon,iday
302       cltext=TRIM(cexper)//' V(m/s) '//TRIM(clmode)
303       !
304       IF( ll_dia_inst) THEN
305          CALL dia_wri_dimg(clname, cltext, vn, jpk, 'T')
306       ELSE
307          CALL dia_wri_dimg(clname, cltext, vm, jpk, 'T')
308       ENDIF
309       !
310
311       !! * KZ section
312
313       WRITE(clname,9000) TRIM(cexper),'KZ',iyear,imon,iday
314       cltext=TRIM(cexper)//' KZ(m2/s) '//TRIM(clmode)
315
316       IF( ll_dia_inst) THEN
317          CALL dia_wri_dimg(clname, cltext, avt, jpk, 'W')
318       ELSE
319          CALL dia_wri_dimg(clname, cltext, avtm, jpk, 'W')
320       ENDIF
321       !
322
323       !! * W section
324
325       WRITE(clname,9000) TRIM(cexper),'W',iyear,imon,iday
326       cltext=TRIM(cexper)//' W(m/s) '//TRIM(clmode)
327
328       IF( ll_dia_inst) THEN
329          CALL dia_wri_dimg(clname, cltext, wn, jpk, 'W')
330       ELSE
331          CALL dia_wri_dimg(clname, cltext, wm, jpk, 'W')
332       ENDIF
333
334       !! * T section
335
336       WRITE(clname,9000) TRIM(cexper),'T',iyear,imon,iday
337       cltext=TRIM(cexper)//' T (DegC) '//TRIM(clmode)
338
339       IF( ll_dia_inst) THEN
340          CALL dia_wri_dimg(clname, cltext, tn, jpk, 'T')
341       ELSE
342          CALL dia_wri_dimg(clname, cltext, tm, jpk, 'T')
343       ENDIF
344       !
345
346       !! * S section
347
348       WRITE(clname,9000) TRIM(cexper),'S',iyear,imon,iday
349       cltext=TRIM(cexper)//' S (PSU) '//TRIM(clmode)
350
351       IF( ll_dia_inst) THEN
352          CALL dia_wri_dimg(clname, cltext, sn, jpk, 'T')
353       ELSE
354          CALL dia_wri_dimg(clname, cltext, sm, jpk, 'T')
355       ENDIF
356       !
357
358       !! * 2D section
359
360       WRITE(clname,9000) TRIM(cexper),'2D',iyear,imon,iday
361       cltext='2D fields '//TRIM(clmode)
362
363       IF( ll_dia_inst) THEN
364          CALL dia_wri_dimg(clname, cltext, fsel, inbsel, '2')
365       ELSE
366          CALL dia_wri_dimg(clname, cltext, fsel, inbsel, '2')
367       ENDIF
368
369       IF( lk_mpp )   CALL mppsync   ! synchronization in mpp
370
371       !! * Log message in numout
372
373       IF( lwp)WRITE(numout,*) ' '
374       IF( lwp)WRITE(numout,*) ' **** WRITE in numwri ',kt
375
376       IF( lwp .AND.        ll_dia_inst) WRITE(numout,*) '    instantaneous fields'
377       IF( lwp .AND. .NOT.  ll_dia_inst) WRITE(numout,*) '    average fields with ',nmoyct,'pdt'
378       !
379       !
380       !! * Reset cumulating arrays  and counter to 0 after writing
381       !
382       IF( .NOT. ll_dia_inst ) THEN
383          nmoyct = 0
384          !
385          um(:,:,:) = 0._wp
386          vm(:,:,:) = 0._wp
387          wm(:,:,:) = 0._wp
388          tm(:,:,:) = 0._wp
389          sm(:,:,:) = 0._wp
390          fsel(:,:,:) = 0._wp
391          avtm(:,:,:) = 0._wp
392       ENDIF
393    ENDIF
394    !
3959000 FORMAT(a,"_",a,"_y",i4.4,"m",i2.2,"d",i2.2,".dimgproc")
396
397  END SUBROUTINE dia_wri
398
399  SUBROUTINE dia_wri_state ( cdfile_name, kt )
400    !!-------------------------------------------------------------------
401    !!        ***     ROUTINE dia_wri_state  ***
402    !!
403    !! ** Purpose :   Dummy routine for compatibility with IOIPSL output
404    !!
405    !! ** History :
406    !!      9.O  ! 03-06  (J.M. Molines ) dimgout
407    !!--------------------------------------------------------------------
408    INTEGER         , INTENT(in) ::   kt            ! ocean time-step index
409    CHARACTER(len=*), INTENT(in) ::   cdfile_name   ! name of the file created
410    !!--------------------------------------------------------------------
411
412    IF( lwp) WRITE(numout,*) 'dia_wri_state: Dummy call', cdfile_name, kt
413    IF( lwp) WRITE(numout,*) '-------------'
414    IF( lwp) WRITE(numout,*)
415
416  END SUBROUTINE dia_wri_state
Note: See TracBrowser for help on using the repository browser.