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 @ 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: 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      ipi = jpiglo
111      ipj = jpjglo
112      ipk = jpk
113
114
115      ! 1. first call kt=nit000
116      ! -----------------------
117
118      IF( kt == nit000 ) THEN
119         nflx1  = 0
120         nflx11 = 0
121         IF(lwp) THEN
122            WRITE(numout,*)
123            WRITE(numout,*) ' global CLIO flx monthly fields in NetCDF format'
124            WRITE(numout,*) ' ------------------------------'
125            WRITE(numout,*)
126         ENDIF
127         
128         ! Read first records
129
130         ! title, dimensions and tests
131         CALL flinopen( clname, mig(1), nlci, mjg(1), nlcj,   &
132            &          .FALSE., ipi, ipj, ipk, zlon, zlat, zlev,   &
133            &          itime, istep, zdate0, zsecond, numflx )
134         
135         ! temperature
136         ! Utilisation d'un spline, on lit le champ a mois=1
137         CALL flinget( numflx, 'socliot1', jpidta, jpjdta, jpk,   &
138            &          jpmois, 1, 1, mig(1), nlci,   &
139            &          mjg(1), nlcj, flxdta(1:nlci,1:nlcj,1,5) )
140
141         ! Extra-halo initialization in MPP
142         IF( lk_mpp ) THEN
143            DO ji = nlci+1, jpi
144               flxdta(ji,:,1,5) = flxdta(1,:,1,5)   ;   flxdta(ji,:,2,5) = flxdta(1,:,2,5)
145            ENDDO
146            DO jj = nlcj+1, jpj
147               flxdta(:,jj,1,5) = flxdta(:,1,1,5)   ;   flxdta(:,jj,2,5) = flxdta(:,1,2,5)
148            ENDDO
149         ENDIF
150      ENDIF
151
152
153      ! Read monthly file
154      ! ----------------
155
156      IF( kt == nit000 .OR. imois /= nflx1 ) THEN
157
158         ! Calendar computation
159
160         ! nflx1 number of the first file record used in the simulation
161         ! nflx2 number of the last  file record
162
163         nflx1 = imois
164         nflx2 = nflx1+1
165         nflx1 = MOD( nflx1, iman )
166         nflx2 = MOD( nflx2, iman )
167         IF( nflx1 == 0 )   nflx1 = iman
168         IF( nflx2 == 0 )   nflx2 = iman
169         IF(lwp) WRITE(numout,*) 'first record file used nflx1 ',nflx1
170         IF(lwp) WRITE(numout,*) 'last  record file used nflx2 ',nflx2
171         
172         ! Read monthly fluxes data
173
174         ! humidity
175         CALL flinget(numflx,'socliohu',jpidta,jpjdta,jpk,jpmois,nflx1,   &
176            nflx1,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,1,1))
177         CALL flinget(numflx,'socliohu',jpidta,jpjdta,jpk,jpmois,nflx2,   &
178            nflx2,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,2,1))
179         ! 10m wind module
180         CALL flinget(numflx,'socliowi',jpidta,jpjdta,jpk,jpmois,nflx1,   &
181            nflx1,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,1,2))
182         CALL flinget(numflx,'socliowi',jpidta,jpjdta,jpk,jpmois,nflx2,   &
183            nflx2,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,2,2))
184         ! cloud cover
185         CALL flinget(numflx,'socliocl',jpidta,jpjdta,jpk,jpmois,nflx1,   &
186            nflx1,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,1,3))
187         CALL flinget(numflx,'socliocl',jpidta,jpjdta,jpk,jpmois,nflx2,   &
188            nflx2,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,2,3))
189         ! precipitations
190         CALL flinget(numflx,'socliopl',jpidta,jpjdta,jpk,jpmois,nflx1,   &
191            nflx1,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,1,4))
192         CALL flinget(numflx,'socliopl',jpidta,jpjdta,jpk,jpmois,nflx2,   &
193            nflx2,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,2,4))
194         
195         IF(lwp .AND. nitend-nit000 <= 100 ) THEN
196            WRITE(numout,*)
197            WRITE(numout,*) ' read clio flx ok'
198            WRITE(numout,*)
199            DO jm = 1, 4
200               WRITE(numout,*)
201               WRITE(numout,*) 'Clio mounth: ',nflx1,'  field: ',jm,' multiply by ',0.1
202               CALL prihre(flxdta(1,1,1,jm),jpi,jpj,1,jpi,20,1,jpj,10,.1,numout)
203            END DO
204         ENDIF
205
206         ! Extra-halo initialization in MPP
207         IF( lk_mpp ) THEN
208            DO ji = nlci+1, jpi
209               flxdta(ji,:,1,1) = flxdta(1,:,1,1)   ;   flxdta(ji,:,2,1) = flxdta(1,:,2,1)
210               flxdta(ji,:,1,2) = flxdta(1,:,1,2)   ;   flxdta(ji,:,2,2) = flxdta(1,:,2,2)
211               flxdta(ji,:,1,3) = flxdta(1,:,1,3)   ;   flxdta(ji,:,2,3) = flxdta(1,:,2,3)
212               flxdta(ji,:,1,4) = flxdta(1,:,1,4)   ;   flxdta(ji,:,2,4) = flxdta(1,:,2,4)
213            ENDDO
214            DO jj = nlcj+1, jpj
215               flxdta(:,jj,1,1) = flxdta(:,1,1,1)   ;   flxdta(:,jj,2,1) = flxdta(:,1,2,1)
216               flxdta(:,jj,1,2) = flxdta(:,1,1,2)   ;   flxdta(:,jj,2,2) = flxdta(:,1,2,2)
217               flxdta(:,jj,1,3) = flxdta(:,1,1,3)   ;   flxdta(:,jj,2,3) = flxdta(:,1,2,3)
218               flxdta(:,jj,1,4) = flxdta(:,1,1,4)   ;   flxdta(:,jj,2,4) = flxdta(:,1,2,4)
219            ENDDO
220         ENDIF
221
222      ENDIF
223
224      ! ------------------- !
225      ! Last call kt=nitend !
226      ! ------------------- !
227
228      ! Closing of the numflx file (required in mpp)
229      IF( kt == nitend ) CALL flinclo(numflx)
230
231
232      IF( kt == nit000 .OR. imois2 /= nflx11 ) THEN
233
234         ! calendar computation
235         
236         ! nflx1 number of the first file record used in the simulation
237         ! nflx2 number of the last  file record
238         
239         nflx11 = imois2
240         nflx12 = nflx11 + 1
241         nflx11 = MOD( nflx11, iman )
242         nflx12 = MOD( nflx12, iman )
243         IF( nflx11 == 0 )   nflx11 = iman
244         IF( nflx12 == 0 )   nflx12 = iman
245         IF(lwp) WRITE(numout,*) 'first record file used nflx11 ',nflx11
246         IF(lwp) WRITE(numout,*) 'last  record file used nflx12 ',nflx12
247         
248         ! Read monthly fluxes data Esbensen Kushnir
249         
250         ! air temperature
251         ! Utilisation d'un spline, on lit le champ a mois=nflx1 et nflx2
252         CALL flinget(numflx,'socliot1',jpidta,jpjdta,jpk,jpmois,nflx11,   &
253            nflx11,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,1,6))
254         CALL flinget(numflx,'socliot1',jpidta,jpjdta,jpk,jpmois,nflx12,   &
255            nflx12,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,2,6))
256         ! air temperature derivative (to reconstruct a daily field)
257         CALL flinget(numflx,'socliot2',jpidta,jpjdta,jpk,jpmois,nflx11,   &
258            nflx11,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,1,7))
259         CALL flinget(numflx,'socliot2',jpidta,jpjdta,jpk,jpmois,nflx12,   &
260            nflx12,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,2,7))
261         
262         IF(lwp) THEN
263            WRITE(numout,*)
264            WRITE(numout,*) ' read CLIO flx ok'
265            WRITE(numout,*)
266            DO jm = 6, jpf
267               WRITE(numout,*) 'jpf =  ', jpf !C a u t i o n : information need for SX5NEC compilo bug
268               WRITE(numout,*) 'Clio mounth: ',nflx11,'  field: ',jm,' multiply by ',0.1
269               CALL prihre(flxdta(1,1,1,jm),jpi,jpj,1,jpi,20,1,jpj,10,.1,numout)
270               WRITE(numout,*)
271            END DO
272         ENDIF
273
274         ! Extra-halo initialization in MPP
275         IF( lk_mpp ) THEN
276            DO ji = nlci+1, jpi
277               flxdta(ji,:,1,6) = flxdta(1,:,1,6)   ;   flxdta(ji,:,2,6) = flxdta(1,:,2,6)
278               flxdta(ji,:,1,7) = flxdta(1,:,1,7)   ;   flxdta(ji,:,2,7) = flxdta(1,:,2,7)
279            ENDDO
280            DO jj = nlcj+1, jpj
281               flxdta(:,jj,1,6) = flxdta(:,1,1,6)   ;   flxdta(:,jj,2,6) = flxdta(:,1,2,6)
282               flxdta(:,jj,1,7) = flxdta(:,1,1,7)   ;   flxdta(:,jj,2,7) = flxdta(:,1,2,7)
283            ENDDO
284         ENDIF
285         
286      ENDIF
287
288
289      ! 3. at every time step interpolation of fluxes
290      ! ---------------------------------------------
291
292      zxy = FLOAT( nday ) / FLOAT( nobis(nflx1) ) + 0.5 - i15
293
294      zdtt = raajj / raamo
295      zdatet = 0.
296      DO jt = 1, nmonth-1
297         zdatet = zdatet + nobis(jt)
298      END DO
299      zdatet = ( zdatet + FLOAT(nday) -1. )/zdtt
300      zttbt = zdatet - INT(zdatet)
301      zttat = 1. - zttbt
302      zdtts6 = zdtt/6.
303
304      hatm(:,:) = ( (1.-zxy) * flxdta(:,:,1,1) + zxy * flxdta(:,:,2,1) )
305      vatm(:,:) = ( (1.-zxy) * flxdta(:,:,1,2) + zxy * flxdta(:,:,2,2) )
306      catm(:,:) = ( (1.-zxy )* flxdta(:,:,1,3) + zxy * flxdta(:,:,2,3) )
307      watm(:,:) = ( (1.-zxy) * flxdta(:,:,1,4) + zxy * flxdta(:,:,2,4) )
308      tatm(:,:) = ( flxdta(:,:,2,6) - flxdta(:,:,1,6) )/zdtt   &
309                - ((3. * zttat * zttat - 1.) * flxdta(:,:,1,7)   &
310                - ( 3. * zttbt * zttbt - 1.) * flxdta(:,:,2,7) ) * zdtts6   &
311                + flxdta(:,:,1,5)
312 
313      CALL blk( kt )                ! bulk formulea fluxes
314
315   END SUBROUTINE flx
Note: See TracBrowser for help on using the repository browser.