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

Last change on this file since 247 was 247, checked in by opalod, 19 years ago

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