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

Last change on this file since 389 was 389, checked in by opalod, 18 years ago

RB:nemo_v1_update_038: first integration of Agrif :

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