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

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

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