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

source: trunk/NEMO/OPA_SRC/SBC/flx_forced_daily.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: 7.2 KB
Line 
1   !!----------------------------------------------------------------------
2   !!                    ***  flx_forced_daily  ***
3   !!----------------------------------------------------------------------
4
5   !!----------------------------------------------------------------------
6   !!   flx          : define the thermohaline fluxes for the ocean
7   !!                  in forced mode using flux formulation (not bulk)
8   !!                  (read in NetCDF file)
9   !!----------------------------------------------------------------------
10   !! * Modules used     C A U T I O N  already defined in flxmod.F90
11
12   !! * Module variables
13   INTEGER ::          &
14      numflx,          &  ! logical unit for surface fluxes data
15      nflx1, nflx2,    &  !  first and second record used
16      nflx11, nflx12,  &  ! ???
17      ndayflx,         &  ! new day for ecmwf flx forcing
18      nyearflx            ! new year for ecmwf flx forcing
19   REAL(wp), DIMENSION(jpi,jpj,3) ::   &
20      flxdta              ! 3 consecutive daily fluxes
21   !!----------------------------------------------------------------------
22   !!   OPA 9.0 , LODYC-IPSL  (2003)
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 daily flux file in NetCDF files
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 (kg/m2/s)
38      !!      (evaporation - precipitation)
39      !!
40      !! History :
41      !!        !  90-03  (O. Marti and P. Dandin)  Original code
42      !!        !  92-07  (M. Imbard)
43      !!        !  96-11  (E. Guilyardi)  Daily AGCM input files
44      !!        !  99-11  (M. Imbard)  NetCDF FORMAT with ioipsl
45      !!        !  00-10  (J.-P. Boulanger)  adjusted for reading any
46      !!                         daily wind stress data including a climatology
47      !!        !  01-09  (A. Lazar and C. Levy)  config with no ice model
48      !!   8.5  !  03-07  (G. Madec)  F90: Free form and module
49      !!----------------------------------------------------------------------
50      !! * Modules used
51      USE ioipsl
52      USE flx_oce
53
54      !! * arguments
55      INTEGER, INTENT( in  ) ::   kt ! ocean time step
56
57      !! * local declarations
58      INTEGER ::   ji, jj, jk        ! dummy loop arguments
59      INTEGER ::   iprint
60      INTEGER ::   i15, iy, iday, idy, ipi, ipj, ipk
61      INTEGER ,DIMENSION(366) :: istep
62
63      REAL(wp), DIMENSION(jpi,jpj) :: zlon, zlat
64      REAL(wp), DIMENSION(jpi,jpj) :: zeri, zerps, ziclim
65      REAL(wp), DIMENSION(jpk)     :: zlev
66      REAL(wp) ::   zdate0, zdt
67
68      CHARACTER (len=40) :: clname
69      !!---------------------------------------------------------------------
70
71
72#if defined key_mpp
73      == >> forced compile error:
74      flx_forced_daily : Reading Netcdf file in mpp Not yet implemented
75#endif
76
77      ! Initialization
78      ! -----------------
79     
80      ! year month day
81      i15 = INT( 2.* FLOAT(nday) / (FLOAT( nobis(nmonth) ) + 0.5) )
82      ipi = jpiglo
83      ipj = jpjglo
84      ipk = jpk
85      IF( nleapy == 0 ) THEN
86         idy = 365
87      ELSE IF( nleapy == 1 ) THEN
88         IF( MOD( nyear ,4 ) == 0 ) THEN
89            idy = 366
90         ELSE
91            idy = 365
92         ENDIF
93      ELSE IF( nleapy == 30 ) THEN
94         IF(lwp) WRITE(numout,cform_err)
95         IF(lwp) WRITE(numout,*)'flx.forced.h : nleapy = 30 is non compatible'
96         IF(lwp) WRITE(numout,*)'               with existing files'
97         nstop = nstop + 1
98      ENDIF
99
100
101      ! First call kt=nit000
102      ! --------------------
103
104      IF( kt == nit000 ) THEN
105         IF(lwp) WRITE(numout,*)
106         IF(lwp) WRITE(numout,*) 'flx   : daily fluxes Q, Qsr, EmP'
107         IF(lwp) WRITE(numout,*) '~~ '
108         ndayflx  = 0
109         nyearflx = 0
110      ENDIF
111
112
113      ! Open files if nyearflx
114      ! ----------------------
115
116      IF( nyearflx /= nyear ) THEN
117         nyearflx = nyear
118         iprint   = 1
119
120         ! Define file name and record
121         
122         ! Close/open file if new year
123
124         IF( nyearflx /= 0 )   CALL flinclo(numflx)
125
126         iy = nyear
127         IF(lwp) WRITE (numout,*) iy
128         WRITE(clname,'("flx_1d.nc")')
129         IF(lwp) WRITE (numout,*)' open flx file = ',clname
130         CALL FLUSH(numout)
131         
132         CALL flinopen(clname,mig(1),nlci,mjg(1),nlcj,.FALSE.,ipi,ipj   &
133              ,ipk,zlon,zlat,zlev,idy,istep,zdate0,zdt,numflx)
134
135         IF( ipi /= jpidta .AND. ipj /= jpjdta .AND. ipk /= 1 ) THEN
136            IF(lwp) WRITE(numout,cform_err)
137            IF(lwp) WRITE(numout,*)
138            IF(lwp) WRITE(numout,*) 'problem with dimensions'
139            IF(lwp) WRITE(numout,*) ' ipi ',ipi,' jpidta ',jpidta
140            IF(lwp) WRITE(numout,*) ' ipj ',ipj,' jpjdta ',jpjdta
141            IF(lwp) WRITE(numout,*) ' ipk ',ipk,' =? 1'
142            nstop = nstop + 1
143         ENDIF
144         IF(lwp) WRITE(numout,*) idy,istep,zdate0,zdt,numflx
145      ELSE
146         iprint = 0
147      ENDIF
148
149      ! Read daily fluxes in flxdta(1,1,jm)
150      !     1. Qtot    (w/m2)
151      !     2. Qsr     (w/m2)
152      !     3. emp     (kg/m2/s)
153     
154      IF( ndayflx /= nday ) THEN
155         ndayflx = nday
156         
157         iday = nday_year
158         
159         ! read Qtot
160         CALL flinget(numflx,'sohefldo',jpidta,jpjdta,1,idy,iday,   &
161              iday,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,1))
162         ! read qsr
163         CALL flinget(numflx,'soshfldo',jpidta,jpjdta,1,idy,iday,   &
164              iday,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,2))
165         ! read emp
166         CALL flinget(numflx,'sowaflup',jpidta,jpjdta,1,idy,iday,   &
167              iday,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,3))
168
169         IF(lwp) WRITE (numout,*)'Lecture flx record :',iday
170
171         IF( nit000 == 1 ) THEN
172            IF( kt == nit000 ) THEN
173               IF(lwp) THEN
174                  WRITE(numout,*)
175                  WRITE(numout,*) ' read daily fluxes ok'
176                  WRITE(numout,*)
177                  WRITE(numout,*) ' Q * .1, day: ',ndastp
178                  CALL prihre(flxdta(1,1,1),jpi,jpj,1,jpi,20,1,jpj,10,.1,numout)
179                  WRITE(numout,*)
180                  WRITE(numout,*) ' QSR * .1, day: ',ndastp
181                  CALL prihre(flxdta(1,1,2),jpi,jpj,1,jpi,20,1,jpj,10,.1,numout)
182                  WRITE(numout,*)
183                  WRITE(numout,*) ' E-P *86400, day: ',ndastp
184                  CALL prihre(flxdta(1,1,3),jpi,jpj,1,jpi,20,1,jpj,10,86400.,numout)
185                  WRITE(numout,*) ' '
186               ENDIF
187            ENDIF
188         ENDIF
189      ENDIF
190
191      p_qt (:,:) = flxdta(:,:,1)
192      p_qsr(:,:) = flxdta(:,:,2)
193      p_emp(:,:) = flxdta(:,:,3)
194 
195      ! Boundary condition on emp for free surface option
196      ! -------------------------------------------------
197      CALL lbc_lnk( p_emp, 'T', 1. )
198 
199 
200      ! Closing all files
201      ! -----------------
202 
203      IF( kt == nitend ) CALL flinclo( numflx )
204 
205   END SUBROUTINE flx
Note: See TracBrowser for help on using the repository browser.