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_fdir.h90 in trunk/NEMO/OPA_SRC/DIA – NEMO

source: trunk/NEMO/OPA_SRC/DIA/diawri_fdir.h90 @ 3

Last change on this file since 3 was 3, checked in by opalod, 20 years ago

Initial revision
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 10.6 KB
Line 
1   !!---------------------------------------------------------------------
2   !!                           diawri_fdir.h90
3   !!                         *******************
4   !!---------------------------------------------------------------------
5   !!   dia_wri : create the standart direct access output files
6   !!---------------------------------------------------------------------
7
8   SUBROUTINE dia_wri ( kt, kindic )
9      !!---------------------------------------------------------------------
10      !!                  ***  ROUTINE diawri  ***
11      !!   
12      !! ** Purpose :   Standard output of opa: dynamics and tracer fields
13      !!      in direct access format
14      !!
15      !! ** Method  :   At the first time step (nit000), output of the grid-
16      !!      point position and depth and of the mask at t-point.
17      !!      Each nwrite time step, output of velocity fields (un,vn,wn)
18      !!      tracer fields (tn,sn) and three two dimensional selected fields,
19      !!      usually the thermohaline forcing fields (q, e, qsr).
20      !!      If kindic <0, output of fields before the model interruption.
21      !!      If kindic =0, time step loop
22      !!      If kindic >0, output of fields before the time step loop
23      !!
24      !! History :
25      !!        !  91-03  ()  Original code
26      !!        !  91-11  (G. Madec)
27      !!        !  92-06  (M. Imbard)  correction restart file
28      !!        !  92-07  (M. Imbard)  split into diawri and rstwri
29      !!        !  93-03  (M. Imbard)  suppress writibm
30      !!        !  94-12  (M. Imbard)  access direct format
31      !!   8.5  !  02-09  (G. Madec)  F90: Free form and module
32      !!----------------------------------------------------------------------
33      !! * Arguments
34      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
35      INTEGER, INTENT( in ) ::   kindic  !
36
37      !! * Save variables
38      INTEGER, SAVE ::   &
39         nmoyct,      &  ! time-step counter for averaging
40         nstepo          ! output number
41#   if ! defined key_diainstant
42      REAL(wp), SAVE, DIMENSION(jpi,jpj,jpk) ::   &
43         um, vm, wm,  &  ! average value of velocity components
44         tm, sm,      &  ! average value of temperature and salinity
45         am,          &  ! average value of vert.diffusivity coef.
46         fsel            ! average value of 2D fields collected in a 2D one
47#   endif
48
49      !! * Local declarations
50      INTEGER ::   inum = 11     ! temporary logical unit
51      INTEGER ::   inbrec, inbsel
52      INTEGER ::   jk, jc
53      INTEGER ::   ilglo, ibloc, ierror, ic
54      REAL(wp) :: zmoyctr
55#if defined key_diainstant
56      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
57         zsel           ! temporary array for 2D fields collected in a 3D one
58#endif
59      CHARACTER (len=40) ::   clhstnam
60      CHARACTER (len=21) ::   cldir, clunf, clunk
61      CHARACTER (len=80) ::   classign
62      !!----------------------------------------------------------------------
63     
64     
65      ! 1. Initialization
66      ! -----------------
67     
68      inbrec = 7
69      inbsel = 13
70
71      IF( kt == nit000 .AND. kindic > 0 ) THEN
72
73         ! 0.1 Open specifier
74
75         clunk = 'UNKNOWN'
76         clunf = 'UNFORMATTED'
77         cldir = 'DIRECT'
78
79         ! computation of the record length for direct access file
80         ! this length depend of 512 for the t3d machine
81
82         ibloc = 4096
83         ilglo = ibloc*( (jpiglo*jpjglo*jpbytda-1 )/ibloc+1)
84
85         CALL dia_nam(clhstnam,nwrite,' ')
86         DO jc=1,40
87            IF( clhstnam(jc:jc) == ' ' ) go to 120
88         END DO
89120      CONTINUE
90         ic=jc
91         clhstnam=clhstnam(1:ic-1)//".fd"
92         CALL ctlopn( inum, 'date.file', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', 1, numout, lwp, 1 )
93         WRITE(inum,*) clhstnam
94         CLOSE(inum)
95         WRITE (UNIT = classign,FMT ='(''assign -F null -N ieee f:'',a40)') clhstnam
96         IF(lwp) WRITE(numout,*) classign
97#if defined _CRAY
98         CALL ASSIGN(classign, ierror)
99#endif
100         IF(lwp)WRITE(numout,*) '   ierror assign = ',ierror
101         CALL ctlopn( numwri, clhstnam, clunk, clunf, cldir,   &
102            ilglo, numout, lwp, 1 )
103      ENDIF
104
105#if ! defined key_diainstant
106
107      IF( kt == nit000 .AND. kindic > 0 ) THEN
108
109         ! 1.1.1 Prognostic variables
110         
111         nmoyct = 0
112         nstepo = 0
113         
114         um(:,:,:) = 0.e0
115         vm(:,:,:) = 0.e0
116         wm(:,:,:) = 0.e0
117         tm(:,:,:) = 0.e0
118         sm(:,:,:) = 0.e0
119         am(:,:,:) = 0.e0
120
121         fsel(:,:,:) = 0.e0
122      ENDIF
123
124      ! 1.2 Sum
125     
126      nmoyct = nmoyct+1
127     
128      um(:,:,:) = um (:,:,:) + un(:,:,:)
129      vm(:,:,:) = vm (:,:,:) + vn(:,:,:)
130      wm(:,:,:) = wm (:,:,:) + wn(:,:,:)
131      tm(:,:,:) = tm (:,:,:) + tn(:,:,:)
132      sm(:,:,:) = sm (:,:,:) + sn(:,:,:)
133      am(:,:,:) = am (:,:,:) +avt(:,:,:)
134     
135      fsel(:,:,1 ) = fsel(:,:,1 ) + taux(:,:)
136      fsel(:,:,2 ) = fsel(:,:,2 ) + tauy(:,:)
137      fsel(:,:,3 ) = fsel(:,:,3 ) + qt  (:,:)
138      fsel(:,:,4 ) = fsel(:,:,4 ) + (emp(:,:) - runoff(:,:))*rday
139#if defined key_dtasst
140      fsel(:,:,5 ) = fsel(:,:,5 ) + sst (:,:)
141#else
142      fsel(:,:,5 ) = fsel(:,:,5 ) + tb  (:,:,1)
143#endif
144      fsel(:,:,6 ) = fsel(:,:,6 ) + qsr (:,:)
145#if defined key_dynspg_fsc
146      fsel(:,:,7 ) = fsel(:,:,7 ) + sshn(:,:)
147#else
148      fsel(:,:,7 ) = fsel(:,:,7 ) + bsfn(:,:)
149#endif
150      fsel(:,:,8 ) = fsel(:,:,8 ) + freeze(:,:)
151      fsel(:,:,9 ) = fsel(:,:,9 ) + qrp (:,:)
152      fsel(:,:,10) = fsel(:,:,10) + erp (:,:)*rday
153      fsel(:,:,11) = fsel(:,:,11) + hmlp(:,:)
154      fsel(:,:,12) = fsel(:,:,12) + emp (:,:)*rday*sb(:,:,1)
155      fsel(:,:,13) = fsel(:,:,13) + erp (:,:)*rday*sb(:,:,1)
156      fsel(:,:,14) = fsel(:,:,14) + hmld(:,:)
157      fsel(:,:,15) = 0.e0
158      fsel(:,:,16) = fsel(:,:,16) + runoff(:,:)
159      ! vertical sum of intantaneous in situ density anomaly
160            fsel(:,:,17) = 0.
161      DO jk =1, jpk
162         fsel(:,:,17) = fsel(:,:,17) + rhd(:,:,jk) * e1t(:,:) * e2t(:,:) * fse3t(:,:,jk)
163      END DO
164      ! 1.2 Output of the model domain (at nit000)
165     
166      IF( kt == nit000 .AND. kindic > 0 ) THEN
167         IF(lwp) WRITE ( numwri, REC=1 ) jpiglo, jpjglo, jpk
168      ENDIF
169     
170     
171      ! 2. Output of dynamics and tracer fields and selected fields (numwri)
172      ! -----------------------------------------------------------
173     
174      ! 2.1 Average
175     
176      IF( MOD( kt, nwrite ) == 0 .OR. kindic < 0 .OR.    &
177         ( kt == nit000 .AND. kindic > 0) .OR. kt == nitend ) THEN
178
179         IF(kindic /= -3) THEN
180            zmoyctr = 1. / FLOAT(nmoyct)
181            um  (:,:,:) = um  (:,:,:) * zmoyctr
182            vm  (:,:,:) = vm  (:,:,:) * zmoyctr
183            wm  (:,:,:) = wm  (:,:,:) * zmoyctr
184            tm  (:,:,:) = tm  (:,:,:) * zmoyctr
185            sm  (:,:,:) = sm  (:,:,:) * zmoyctr
186            am  (:,:,:) = am  (:,:,:) * zmoyctr
187            fsel(:,:,:) = fsel(:,:,:) * zmoyctr
188           
189         ELSE
190            ! kindic=-3 STOP with  e r r o r, instantaneous output
191            nmoyct = 1
192            um(:,:,:) = un (:,:,:)
193            vm(:,:,:) = vn (:,:,:)
194            wm(:,:,:) = wn (:,:,:)
195            tm(:,:,:) = tn (:,:,:)
196            sm(:,:,:) = sn (:,:,:)
197            am(:,:,:) = avt(:,:,:)
198           
199            fsel(:,:,1 ) = taux(:,:)
200            fsel(:,:,2 ) = tauy(:,:)
201            fsel(:,:,3 ) = qt  (:,:)
202            fsel(:,:,4 ) = (emp (:,:)- runoff(:,:))*rday
203#if defined key_dtasst
204            fsel(:,:,5 ) = sst (:,:)
205#else
206            fsel(:,:,5 ) = tb  (:,:,1)
207#endif
208            fsel(:,:,6 ) = qsr (:,:)
209#if defined key_dynspg_fsc
210            fsel(:,:,7 ) = sshn(:,:)
211#else
212            fsel(:,:,7 ) = bsfn(:,:)
213#endif
214            fsel(:,:,8 ) = freeze(:,:)
215            fsel(:,:,9 ) = qrp (:,:)
216            fsel(:,:,10) = erp (:,:)
217            fsel(:,:,11) = hmlp(:,:)
218            fsel(:,:,12) = emp (:,:)*rday*sb(:,:,1)
219            fsel(:,:,13) = erp (:,:)*rday*sb(:,:,1)
220            fsel(:,:,14) = hmld(:,:)
221            fsel(:,:,15) = 0.e0
222            fsel(:,:,16) = runoff(:,:)
223         ENDIF
224
225         ! 2.2 Write
226         
227         IF(lwp) THEN
228            um(3,1,1) = FLOAT( kt )
229            vm(3,1,1) = FLOAT( nmoyct )
230         ENDIF
231         CALL write4( numwri, um  , nstepo*inbrec+2 )
232         CALL write4( numwri, vm  , nstepo*inbrec+3 )
233         CALL write4( numwri, wm  , nstepo*inbrec+4 )
234         CALL write4( numwri, tm  , nstepo*inbrec+5 )
235         CALL write4( numwri, sm  , nstepo*inbrec+6 )
236         CALL write4( numwri, am  , nstepo*inbrec+7 )
237         CALL write4( numwri, fsel, nstepo*inbrec+8 )
238         
239         IF(lwp) WRITE(numout,*) ' '
240         IF(lwp) WRITE(numout,*) ' **** write in numwri ',kt
241         IF(lwp) WRITE(numout,*) '    average fields with ',nmoyct,'pdt'
242         
243         ! 2.3 Zero initialisation
244         
245         nmoyct = 0
246         nstepo = nstepo+1
247         
248         um(:,:,:) = 0.e0
249         vm(:,:,:) = 0.e0
250         wm(:,:,:) = 0.e0
251         tm(:,:,:) = 0.e0
252         sm(:,:,:) = 0.e0
253         am(:,:,:) = 0.e0
254         
255         fsel(:,:,:) = 0.e0
256         
257      ENDIF
258     
259#else
260
261      ! Sortie instantanee
262     
263      IF( kt == nit000 .AND. kindic > 0 ) THEN
264         nstepo = 0
265         IF(lwp) WRITE ( numwri, REC=1 ) jpiglo, jpjglo, jpk
266      ENDIF
267     
268      IF( MOD( kt, nwrite ) == 0 .OR. kindic < 0   &
269         .OR. (kt == nit000 .AND. kindic > 0) .OR.  kt == nitend ) THEN
270         fsel(:,:,:) = 0.e0
271         
272         zsel(:,:,1 ) = taux(:,:) * umask(:,:,1)
273         zsel(:,:,2 ) = tauy(:,:) * vmask(:,:,1)
274         zsel(:,:,3 ) = qt  (:,:)
275         zsel(:,:,4 ) = (emp (:,:)-runoff(:,:))*rday
276#if defined key_dtasst
277         zsel(:,:,5 ) = sst (:,:)
278#else
279         zsel(:,:,5 ) = tb  (:,:,1)
280#endif
281         zsel(:,:,6 ) = qsr (:,:)
282#if defined key_dynspg_fsc
283         zsel(:,:,7 ) = sshn(:,:)
284#else
285         zsel(:,:,7 ) = bsfn(:,:)
286#endif
287         zsel(:,:,8 ) = freeze(:,:)
288         zsel(:,:,9 ) = qrp (:,:)
289         zsel(:,:,10) = erp (:,:)
290         zsel(:,:,11) = hmlp(:,:)
291         zsel(:,:,12) = emp (:,:) * sb(:,:,1)
292         zsel(:,:,13) = erp (:,:) * sb(:,:,1)
293         zsel(:,:,14) = hmld(:,:)
294         zsel(:,:,15) = 0.e0
295         zsel(:,:,16) = runoff(:,:)
296         
297         CALL write4( numwri, un  , nstepo*inbrec+2 )
298         CALL write4( numwri, vn  , nstepo*inbrec+3 )
299         CALL write4( numwri, wn  , nstepo*inbrec+4 )
300         CALL write4( numwri, tn  , nstepo*inbrec+5 )
301         CALL write4( numwri, sn  , nstepo*inbrec+6 )
302         CALL write4( numwri, avt , nstepo*inbrec+7 )
303         CALL write4( numwri, zsel, nstepo*inbrec+8 )
304         
305         IF(lwp) WRITE(numout,*)
306         IF(lwp) WRITE(numout,*) ' **** write in numwri ',kt
307         IF(lwp) WRITE(numout,*) '    instantaneous fields'
308         nstepo = nstepo+1
309      ENDIF
310     
311   END SUBROUTINE dia_wri
Note: See TracBrowser for help on using the repository browser.