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

source: trunk/NEMO/OPA_SRC/SBC/flx_bulk_monthly.h90 @ 359

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

nemo_v1_bugfix_012:RB: initialize itime before calling flinopen
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 12.8 KB
Line 
1   !!----------------------------------------------------------------------
2   !!                    ***  flx_blulk_monthly.h90  ***
3   !!----------------------------------------------------------------------
4   !!   flx     : update surface thermohaline fluxes using bulk formulae
5   !!             and fields read in a NetCDF file
6   !!----------------------------------------------------------------------
7   !! * Modules used     C A U T I O N  already defined in flxmod.F90
8
9   !! * Module variables
10   
11   INTEGER ::          &
12      ji, jj,          &  ! loop indices
13      numflx,          &  ! logical unit for surface fluxes data
14      nflx1, nflx2,    &  !  first and second record used
15      nflx11, nflx12      ! ???
16
17   REAL(wp), DIMENSION(jpi,jpj,2,7) ::   &
18      flxdta              ! 2 consecutive set of CLIO monthly fluxes
19   !!----------------------------------------------------------------------
20   !!   OPA 9.0 , LOCEAN-IPSL (2005)
21   !! $Header$
22   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
23   !!----------------------------------------------------------------------
24
25CONTAINS
26
27   SUBROUTINE flx( kt )
28      !!---------------------------------------------------------------------
29      !!                     ***  ROUTINE flx  ***
30      !!                   
31      !! ** Purpose :   provide the thermohaline fluxes (heat and freshwater)
32      !!      to the ocean at each time step.
33      !!
34      !! ** Method  :   Read monthly climatological fluxes in a NetCDF file
35      !!          the net downward radiative flux qsr      1 (watt/m2)
36      !!          the net downward heat flux      q        2 (watt/m2)
37      !!          the net upward water            emp      3 (mm/month)
38      !!              (evaporation - precipitation)
39      !!          the climatological ice cover    rclice   4 (0 or 1)
40      !!
41      !!     Qsr and q is obtained from Esbensen-Kushnir data (opal file) with
42      !!   some corrections :
43      !!          - Data are extended over the polar area and for the net heat
44      !!            flux, values are put at 200 w/m2 on the ice regions
45      !!          - Red sea and Mediterranean values are imposed.
46      !!
47      !!     emp is the Oberhuber climatology with a function of Levitus
48      !!   salinity
49      !!
50      !!     rclice is an handmade climalological ice cover on the polar
51      !!   regions.
52      !!
53      !!     runoff is an handmade climalological runoff.
54      !!
55      !! caution : now, in the opa global model, the net upward water flux is
56      !! -------   with mm/day unit.
57      !!
58      !! History :
59      !!        !  91-03  (O. Marti and Ph Dandin)  Original code
60      !!        !  92-07  (M. Imbard)
61      !!        !  96-11  (E. Guilyardi)  Daily AGCM input files
62      !!        !  99-11  (M. Imbard)  NetCDF FORMAT with ioipsl
63      !!        !  00-10  (J.-P. Boulanger)  adjusted for reading any
64      !!                         daily wind stress data including a climatology
65      !!        !  01-09  (A. Lazar and C. Levy)  Daily NetCDF by default
66      !!   8.5  !  02-09  (G. Madec)  F90: Free form and module
67      !!----------------------------------------------------------------------
68      !! * modules used
69      USE ioipsl
70      USE blk_oce         ! bulk variable
71      USE bulk            ! bulk module
72
73      !! * arguments
74      INTEGER, INTENT( in  ) ::   kt   ! ocean time step
75
76      !! * Local declarations
77      INTEGER, PARAMETER ::   &
78         jpmois = 12,               &  ! number of months
79         jpf    =  7                   ! ??? !bug ?
80      INTEGER ::   jm, jt      ! dummy loop indices
81      INTEGER ::   &
82         imois, imois2, itime,      &  ! temporary integers
83         i15  , iman  ,             &  !    "          "
84         ipi  , ipj   , ipk            !    "          "
85      INTEGER, DIMENSION(jpmois) ::   &
86         istep                         ! ???
87      REAL(wp) ::   &
88         zsecond, zdate0,           &  ! temporary scalars
89         zxy    , zdtt  ,           &  !    "         "
90         zdatet , zttbt ,           &  !    "         "
91         zttat  , zdtts6               !    "         "
92      REAL(wp), DIMENSION(jpk) ::   &
93         zlev                          ! ???
94      REAL(wp), DIMENSION(jpi,jpj) ::   &
95         zlon   , zlat                 ! ???
96      CHARACTER (len=32) ::   &
97         clname = 'flx.nc'             ! flux filename
98      !!---------------------------------------------------------------------
99
100
101      ! Initialization
102      ! --------------
103
104      i15 = INT( 2 * FLOAT( nday ) / ( FLOAT( nobis(nmonth) ) + 0.5 ) )
105      iman  = 12
106      imois = nmonth + i15 - 1
107      IF( imois == 0 ) imois = iman
108      imois2 = nmonth
109
110      itime = jpmois
111     
112      ipi = jpiglo
113      ipj = jpjglo
114      ipk = jpk
115
116
117      ! 1. first call kt=nit000
118      ! -----------------------
119
120      IF( kt == nit000 ) THEN
121         nflx1  = 0
122         nflx11 = 0
123         IF(lwp) THEN
124            WRITE(numout,*)
125            WRITE(numout,*) ' global CLIO flx monthly fields in NetCDF format'
126            WRITE(numout,*) ' ------------------------------'
127            WRITE(numout,*)
128         ENDIF
129         
130         ! Read first records
131
132         ! title, dimensions and tests
133         CALL flinopen( clname, mig(1), nlci, mjg(1), nlcj,   &
134            &          .FALSE., ipi, ipj, ipk, zlon, zlat, zlev,   &
135            &          itime, istep, zdate0, zsecond, numflx )
136         
137         ! temperature
138         ! Utilisation d'un spline, on lit le champ a mois=1
139         CALL flinget( numflx, 'socliot1', jpidta, jpjdta, jpk,   &
140            &          jpmois, 1, 1, mig(1), nlci,   &
141            &          mjg(1), nlcj, flxdta(1:nlci,1:nlcj,1,5) )
142
143         ! Extra-halo initialization in MPP
144         IF( lk_mpp ) THEN
145            DO ji = nlci+1, jpi
146               flxdta(ji,:,1,5) = flxdta(1,:,1,5)   ;   flxdta(ji,:,2,5) = flxdta(1,:,2,5)
147            ENDDO
148            DO jj = nlcj+1, jpj
149               flxdta(:,jj,1,5) = flxdta(:,1,1,5)   ;   flxdta(:,jj,2,5) = flxdta(:,1,2,5)
150            ENDDO
151         ENDIF
152      ENDIF
153
154
155      ! Read monthly file
156      ! ----------------
157
158      IF( kt == nit000 .OR. imois /= nflx1 ) THEN
159
160         ! Calendar computation
161
162         ! nflx1 number of the first file record used in the simulation
163         ! nflx2 number of the last  file record
164
165         nflx1 = imois
166         nflx2 = nflx1+1
167         nflx1 = MOD( nflx1, iman )
168         nflx2 = MOD( nflx2, iman )
169         IF( nflx1 == 0 )   nflx1 = iman
170         IF( nflx2 == 0 )   nflx2 = iman
171         IF(lwp) WRITE(numout,*) 'first record file used nflx1 ',nflx1
172         IF(lwp) WRITE(numout,*) 'last  record file used nflx2 ',nflx2
173         
174         ! Read monthly fluxes data
175
176         ! humidity
177         CALL flinget(numflx,'socliohu',jpidta,jpjdta,jpk,jpmois,nflx1,   &
178            nflx1,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,1,1))
179         CALL flinget(numflx,'socliohu',jpidta,jpjdta,jpk,jpmois,nflx2,   &
180            nflx2,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,2,1))
181         ! 10m wind module
182         CALL flinget(numflx,'socliowi',jpidta,jpjdta,jpk,jpmois,nflx1,   &
183            nflx1,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,1,2))
184         CALL flinget(numflx,'socliowi',jpidta,jpjdta,jpk,jpmois,nflx2,   &
185            nflx2,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,2,2))
186         ! cloud cover
187         CALL flinget(numflx,'socliocl',jpidta,jpjdta,jpk,jpmois,nflx1,   &
188            nflx1,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,1,3))
189         CALL flinget(numflx,'socliocl',jpidta,jpjdta,jpk,jpmois,nflx2,   &
190            nflx2,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,2,3))
191         ! precipitations
192         CALL flinget(numflx,'socliopl',jpidta,jpjdta,jpk,jpmois,nflx1,   &
193            nflx1,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,1,4))
194         CALL flinget(numflx,'socliopl',jpidta,jpjdta,jpk,jpmois,nflx2,   &
195            nflx2,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,2,4))
196         
197         IF(lwp .AND. nitend-nit000 <= 100 ) THEN
198            WRITE(numout,*)
199            WRITE(numout,*) ' read clio flx ok'
200            WRITE(numout,*)
201            DO jm = 1, 4
202               WRITE(numout,*)
203               WRITE(numout,*) 'Clio mounth: ',nflx1,'  field: ',jm,' multiply by ',0.1
204               CALL prihre(flxdta(1,1,1,jm),jpi,jpj,1,jpi,20,1,jpj,10,.1,numout)
205            END DO
206         ENDIF
207
208         ! Extra-halo initialization in MPP
209         IF( lk_mpp ) THEN
210            DO ji = nlci+1, jpi
211               flxdta(ji,:,1,1) = flxdta(1,:,1,1)   ;   flxdta(ji,:,2,1) = flxdta(1,:,2,1)
212               flxdta(ji,:,1,2) = flxdta(1,:,1,2)   ;   flxdta(ji,:,2,2) = flxdta(1,:,2,2)
213               flxdta(ji,:,1,3) = flxdta(1,:,1,3)   ;   flxdta(ji,:,2,3) = flxdta(1,:,2,3)
214               flxdta(ji,:,1,4) = flxdta(1,:,1,4)   ;   flxdta(ji,:,2,4) = flxdta(1,:,2,4)
215            ENDDO
216            DO jj = nlcj+1, jpj
217               flxdta(:,jj,1,1) = flxdta(:,1,1,1)   ;   flxdta(:,jj,2,1) = flxdta(:,1,2,1)
218               flxdta(:,jj,1,2) = flxdta(:,1,1,2)   ;   flxdta(:,jj,2,2) = flxdta(:,1,2,2)
219               flxdta(:,jj,1,3) = flxdta(:,1,1,3)   ;   flxdta(:,jj,2,3) = flxdta(:,1,2,3)
220               flxdta(:,jj,1,4) = flxdta(:,1,1,4)   ;   flxdta(:,jj,2,4) = flxdta(:,1,2,4)
221            ENDDO
222         ENDIF
223
224      ENDIF
225
226      ! ------------------- !
227      ! Last call kt=nitend !
228      ! ------------------- !
229
230      ! Closing of the numflx file (required in mpp)
231      IF( kt == nitend ) CALL flinclo(numflx)
232
233
234      IF( kt == nit000 .OR. imois2 /= nflx11 ) THEN
235
236         ! calendar computation
237         
238         ! nflx1 number of the first file record used in the simulation
239         ! nflx2 number of the last  file record
240         
241         nflx11 = imois2
242         nflx12 = nflx11 + 1
243         nflx11 = MOD( nflx11, iman )
244         nflx12 = MOD( nflx12, iman )
245         IF( nflx11 == 0 )   nflx11 = iman
246         IF( nflx12 == 0 )   nflx12 = iman
247         IF(lwp) WRITE(numout,*) 'first record file used nflx11 ',nflx11
248         IF(lwp) WRITE(numout,*) 'last  record file used nflx12 ',nflx12
249         
250         ! Read monthly fluxes data Esbensen Kushnir
251         
252         ! air temperature
253         ! Utilisation d'un spline, on lit le champ a mois=nflx1 et nflx2
254         CALL flinget(numflx,'socliot1',jpidta,jpjdta,jpk,jpmois,nflx11,   &
255            nflx11,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,1,6))
256         CALL flinget(numflx,'socliot1',jpidta,jpjdta,jpk,jpmois,nflx12,   &
257            nflx12,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,2,6))
258         ! air temperature derivative (to reconstruct a daily field)
259         CALL flinget(numflx,'socliot2',jpidta,jpjdta,jpk,jpmois,nflx11,   &
260            nflx11,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,1,7))
261         CALL flinget(numflx,'socliot2',jpidta,jpjdta,jpk,jpmois,nflx12,   &
262            nflx12,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,2,7))
263         
264         IF(lwp) THEN
265            WRITE(numout,*)
266            WRITE(numout,*) ' read CLIO flx ok'
267            WRITE(numout,*)
268            DO jm = 6, jpf
269               WRITE(numout,*) 'jpf =  ', jpf !C a u t i o n : information need for SX5NEC compilo bug
270               WRITE(numout,*) 'Clio mounth: ',nflx11,'  field: ',jm,' multiply by ',0.1
271               CALL prihre(flxdta(1,1,1,jm),jpi,jpj,1,jpi,20,1,jpj,10,.1,numout)
272               WRITE(numout,*)
273            END DO
274         ENDIF
275
276         ! Extra-halo initialization in MPP
277         IF( lk_mpp ) THEN
278            DO ji = nlci+1, jpi
279               flxdta(ji,:,1,6) = flxdta(1,:,1,6)   ;   flxdta(ji,:,2,6) = flxdta(1,:,2,6)
280               flxdta(ji,:,1,7) = flxdta(1,:,1,7)   ;   flxdta(ji,:,2,7) = flxdta(1,:,2,7)
281            ENDDO
282            DO jj = nlcj+1, jpj
283               flxdta(:,jj,1,6) = flxdta(:,1,1,6)   ;   flxdta(:,jj,2,6) = flxdta(:,1,2,6)
284               flxdta(:,jj,1,7) = flxdta(:,1,1,7)   ;   flxdta(:,jj,2,7) = flxdta(:,1,2,7)
285            ENDDO
286         ENDIF
287         
288      ENDIF
289
290
291      ! 3. at every time step interpolation of fluxes
292      ! ---------------------------------------------
293
294      zxy = FLOAT( nday ) / FLOAT( nobis(nflx1) ) + 0.5 - i15
295
296      zdtt = raajj / raamo
297      zdatet = 0.
298      DO jt = 1, nmonth-1
299         zdatet = zdatet + nobis(jt)
300      END DO
301      zdatet = ( zdatet + FLOAT(nday) -1. )/zdtt
302      zttbt = zdatet - INT(zdatet)
303      zttat = 1. - zttbt
304      zdtts6 = zdtt/6.
305
306      hatm(:,:) = ( (1.-zxy) * flxdta(:,:,1,1) + zxy * flxdta(:,:,2,1) )
307      vatm(:,:) = ( (1.-zxy) * flxdta(:,:,1,2) + zxy * flxdta(:,:,2,2) )
308      catm(:,:) = ( (1.-zxy )* flxdta(:,:,1,3) + zxy * flxdta(:,:,2,3) )
309      watm(:,:) = ( (1.-zxy) * flxdta(:,:,1,4) + zxy * flxdta(:,:,2,4) )
310      tatm(:,:) = ( flxdta(:,:,2,6) - flxdta(:,:,1,6) )/zdtt   &
311                - ((3. * zttat * zttat - 1.) * flxdta(:,:,1,7)   &
312                - ( 3. * zttbt * zttbt - 1.) * flxdta(:,:,2,7) ) * zdtts6   &
313                + flxdta(:,:,1,5)
314 
315      CALL blk( kt )                ! bulk formulea fluxes
316
317   END SUBROUTINE flx
Note: See TracBrowser for help on using the repository browser.