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

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

CT : UPDATE001 : First major NEMO update
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 7.3 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( lk_mpp ) THEN
73         IF(lwp) WRITE(numout,cform_err)
74         IF(lwp) WRITE(numout,*) 'flx_forced_daily:  netcdf & mpp not yet possible'
75         nstop = nstop + 1
76      ENDIF
77
78      ! Initialization
79      ! -----------------
80     
81      ! year month day
82      i15 = INT( 2.* FLOAT(nday) / (FLOAT( nobis(nmonth) ) + 0.5) )
83      ipi = jpiglo
84      ipj = jpjglo
85      ipk = jpk
86      IF( nleapy == 0 ) THEN
87         idy = 365
88      ELSE IF( nleapy == 1 ) THEN
89         IF( MOD( nyear ,4 ) == 0 ) THEN
90            idy = 366
91         ELSE
92            idy = 365
93         ENDIF
94      ELSE IF( nleapy == 30 ) THEN
95         IF(lwp) WRITE(numout,cform_err)
96         IF(lwp) WRITE(numout,*)'flx.forced.h : nleapy = 30 is non compatible'
97         IF(lwp) WRITE(numout,*)'               with existing files'
98         nstop = nstop + 1
99      ENDIF
100
101
102      ! First call kt=nit000
103      ! --------------------
104
105      IF( kt == nit000 ) THEN
106         IF(lwp) WRITE(numout,*)
107         IF(lwp) WRITE(numout,*) 'flx   : daily fluxes Q, Qsr, EmP'
108         IF(lwp) WRITE(numout,*) '~~ '
109         ndayflx  = 0
110         nyearflx = 0
111      ENDIF
112
113
114      ! Open files if nyearflx
115      ! ----------------------
116
117      IF( nyearflx /= nyear ) THEN
118         nyearflx = nyear
119         iprint   = 1
120
121         ! Define file name and record
122         
123         ! Close/open file if new year
124
125         IF( nyearflx /= 0 )   CALL flinclo(numflx)
126
127         iy = nyear
128         IF(lwp) WRITE (numout,*) iy
129         WRITE(clname,'("flx_1d.nc")')
130         IF(lwp) WRITE (numout,*)' open flx file = ',clname
131         CALL FLUSH(numout)
132         
133         CALL flinopen(clname,mig(1),nlci,mjg(1),nlcj,.FALSE.,ipi,ipj   &
134              ,ipk,zlon,zlat,zlev,idy,istep,zdate0,zdt,numflx)
135
136         IF( ipi /= jpidta .AND. ipj /= jpjdta .AND. ipk /= 1 ) THEN
137            IF(lwp) WRITE(numout,cform_err)
138            IF(lwp) WRITE(numout,*)
139            IF(lwp) WRITE(numout,*) 'problem with dimensions'
140            IF(lwp) WRITE(numout,*) ' ipi ',ipi,' jpidta ',jpidta
141            IF(lwp) WRITE(numout,*) ' ipj ',ipj,' jpjdta ',jpjdta
142            IF(lwp) WRITE(numout,*) ' ipk ',ipk,' =? 1'
143            nstop = nstop + 1
144         ENDIF
145         IF(lwp) WRITE(numout,*) idy,istep,zdate0,zdt,numflx
146      ELSE
147         iprint = 0
148      ENDIF
149
150      ! Read daily fluxes in flxdta(1,1,jm)
151      !     1. Qtot    (w/m2)
152      !     2. Qsr     (w/m2)
153      !     3. emp     (kg/m2/s)
154     
155      IF( ndayflx /= nday ) THEN
156         ndayflx = nday
157         
158         iday = nday_year
159         
160         ! read Qtot
161         CALL flinget(numflx,'sohefldo',jpidta,jpjdta,1,idy,iday,   &
162              iday,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,1))
163         ! read qsr
164         CALL flinget(numflx,'soshfldo',jpidta,jpjdta,1,idy,iday,   &
165              iday,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,2))
166         ! read emp
167         CALL flinget(numflx,'sowaflup',jpidta,jpjdta,1,idy,iday,   &
168              iday,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,3))
169
170         IF(lwp) WRITE (numout,*)'Lecture flx record :',iday
171
172         IF( nit000 == 1 ) THEN
173            IF( kt == nit000 ) THEN
174               IF(lwp) THEN
175                  WRITE(numout,*)
176                  WRITE(numout,*) ' read daily fluxes ok'
177                  WRITE(numout,*)
178                  WRITE(numout,*) ' Q * .1, day: ',ndastp
179                  CALL prihre(flxdta(1,1,1),jpi,jpj,1,jpi,20,1,jpj,10,.1,numout)
180                  WRITE(numout,*)
181                  WRITE(numout,*) ' QSR * .1, day: ',ndastp
182                  CALL prihre(flxdta(1,1,2),jpi,jpj,1,jpi,20,1,jpj,10,.1,numout)
183                  WRITE(numout,*)
184                  WRITE(numout,*) ' E-P *86400, day: ',ndastp
185                  CALL prihre(flxdta(1,1,3),jpi,jpj,1,jpi,20,1,jpj,10,86400.,numout)
186                  WRITE(numout,*) ' '
187               ENDIF
188            ENDIF
189         ENDIF
190      ENDIF
191
192      p_qt (:,:) = flxdta(:,:,1)
193      p_qsr(:,:) = flxdta(:,:,2)
194      p_emp(:,:) = flxdta(:,:,3)
195 
196      ! Boundary condition on emp for free surface option
197      ! -------------------------------------------------
198      CALL lbc_lnk( p_emp, 'T', 1. )
199 
200 
201      ! Closing all files
202      ! -----------------
203 
204      IF( kt == nitend ) CALL flinclo( numflx )
205 
206   END SUBROUTINE flx
Note: See TracBrowser for help on using the repository browser.