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

Last change on this file since 313 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: 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 , LOCEAN-IPSL (2005)
23   !! $Header$
24   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
25   !!----------------------------------------------------------------------
26
27CONTAINS
28
29   SUBROUTINE flx( kt )
30      !!---------------------------------------------------------------------
31      !!                    ***  ROUTINE flx  ***
32      !!                   
33      !! ** Purpose :   provide the thermohaline fluxes (heat and freshwater)
34      !!      to the ocean at each time step.
35      !!
36      !! ** Method  :   READ daily flux file in NetCDF files
37      !!      the net downward radiative flux qsr      1 (watt/m2)
38      !!      the net downward heat flux      q        2 (watt/m2)
39      !!      the net upward water            emp      3 (kg/m2/s)
40      !!      (evaporation - precipitation)
41      !!
42      !! History :
43      !!        !  90-03  (O. Marti and P. Dandin)  Original code
44      !!        !  92-07  (M. Imbard)
45      !!        !  96-11  (E. Guilyardi)  Daily AGCM input files
46      !!        !  99-11  (M. Imbard)  NetCDF FORMAT with ioipsl
47      !!        !  00-10  (J.-P. Boulanger)  adjusted for reading any
48      !!                         daily wind stress data including a climatology
49      !!        !  01-09  (A. Lazar and C. Levy)  config with no ice model
50      !!   8.5  !  03-07  (G. Madec)  F90: Free form and module
51      !!----------------------------------------------------------------------
52      !! * Modules used
53      USE ioipsl
54      USE flx_oce
55
56      !! * arguments
57      INTEGER, INTENT( in  ) ::   kt ! ocean time step
58
59      !! * local declarations
60      INTEGER ::   ji, jj, jk        ! dummy loop arguments
61      INTEGER ::   iprint
62      INTEGER ::   i15, iy, iday, idy, ipi, ipj, ipk
63      INTEGER ,DIMENSION(366) :: istep
64
65      REAL(wp), DIMENSION(jpi,jpj) :: zlon, zlat
66      REAL(wp), DIMENSION(jpi,jpj) :: zeri, zerps, ziclim
67      REAL(wp), DIMENSION(jpk)     :: zlev
68      REAL(wp) ::   zdate0, zdt
69
70      CHARACTER (len=40) :: clname
71      !!---------------------------------------------------------------------
72
73      ! Initialization
74      ! -----------------
75     
76      ! year month day
77      i15 = INT( 2.* FLOAT(nday) / (FLOAT( nobis(nmonth) ) + 0.5) )
78      ipi = jpiglo
79      ipj = jpjglo
80      ipk = jpk
81      IF( nleapy == 0 ) THEN
82         idy = 365
83      ELSE IF( nleapy == 1 ) THEN
84         IF( MOD( nyear ,4 ) == 0 ) THEN
85            idy = 366
86         ELSE
87            idy = 365
88         ENDIF
89      ELSE IF( nleapy == 30 ) THEN
90         IF(lwp) WRITE(numout,cform_err)
91         IF(lwp) WRITE(numout,*)'flx.forced.h : nleapy = 30 is non compatible'
92         IF(lwp) WRITE(numout,*)'               with existing files'
93         nstop = nstop + 1
94      ENDIF
95
96
97      ! First call kt=nit000
98      ! --------------------
99
100      IF( kt == nit000 ) THEN
101         IF(lwp) WRITE(numout,*)
102         IF(lwp) WRITE(numout,*) 'flx   : daily fluxes Q, Qsr, EmP'
103         IF(lwp) WRITE(numout,*) '~~ '
104         ndayflx  = 0
105         nyearflx = 0
106      ENDIF
107
108
109      ! Open files if nyearflx
110      ! ----------------------
111
112      IF( nyearflx /= nyear ) THEN
113         nyearflx = nyear
114         iprint   = 1
115
116         ! Define file name and record
117         
118         ! Close/open file if new year
119
120         IF( nyearflx /= 0 )   CALL flinclo(numflx)
121
122         iy = nyear
123         IF(lwp) WRITE (numout,*) iy
124         WRITE(clname,'("flx_1d.nc")')
125         IF(lwp) WRITE (numout,*)' open flx file = ',clname
126         CALL FLUSH(numout)
127         
128         CALL flinopen(clname,mig(1),nlci,mjg(1),nlcj,.FALSE.,ipi,ipj   &
129              ,ipk,zlon,zlat,zlev,idy,istep,zdate0,zdt,numflx)
130
131         IF( ipi /= jpidta .AND. ipj /= jpjdta .AND. ipk /= 1 ) THEN
132            IF(lwp) WRITE(numout,cform_err)
133            IF(lwp) WRITE(numout,*)
134            IF(lwp) WRITE(numout,*) 'problem with dimensions'
135            IF(lwp) WRITE(numout,*) ' ipi ',ipi,' jpidta ',jpidta
136            IF(lwp) WRITE(numout,*) ' ipj ',ipj,' jpjdta ',jpjdta
137            IF(lwp) WRITE(numout,*) ' ipk ',ipk,' =? 1'
138            nstop = nstop + 1
139         ENDIF
140         IF(lwp) WRITE(numout,*) idy,istep,zdate0,zdt,numflx
141      ELSE
142         iprint = 0
143      ENDIF
144
145      ! Read daily fluxes in flxdta(1,1,jm)
146      !     1. Qtot    (w/m2)
147      !     2. Qsr     (w/m2)
148      !     3. emp     (kg/m2/s)
149     
150      IF( ndayflx /= nday ) THEN
151         ndayflx = nday
152         
153         iday = nday_year
154         
155         ! read Qtot
156         CALL flinget(numflx,'sohefldo',jpidta,jpjdta,1,idy,iday,   &
157              iday,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,1))
158         ! read qsr
159         CALL flinget(numflx,'soshfldo',jpidta,jpjdta,1,idy,iday,   &
160              iday,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,2))
161         ! read emp
162         CALL flinget(numflx,'sowaflup',jpidta,jpjdta,1,idy,iday,   &
163              iday,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,3))
164
165         IF(lwp) WRITE (numout,*)'Lecture flx record :',iday
166
167         IF( nit000 == 1 ) THEN
168            IF( kt == nit000 ) THEN
169               IF(lwp) THEN
170                  WRITE(numout,*)
171                  WRITE(numout,*) ' read daily fluxes ok'
172                  WRITE(numout,*)
173                  WRITE(numout,*) ' Q * .1, day: ',ndastp
174                  CALL prihre(flxdta(1,1,1),jpi,jpj,1,jpi,20,1,jpj,10,.1,numout)
175                  WRITE(numout,*)
176                  WRITE(numout,*) ' QSR * .1, day: ',ndastp
177                  CALL prihre(flxdta(1,1,2),jpi,jpj,1,jpi,20,1,jpj,10,.1,numout)
178                  WRITE(numout,*)
179                  WRITE(numout,*) ' E-P *86400, day: ',ndastp
180                  CALL prihre(flxdta(1,1,3),jpi,jpj,1,jpi,20,1,jpj,10,86400.,numout)
181                  WRITE(numout,*) ' '
182               ENDIF
183            ENDIF
184         ENDIF
185      ENDIF
186
187      p_qt (:,:) = flxdta(:,:,1)
188      p_qsr(:,:) = flxdta(:,:,2)
189      p_emp(:,:) = flxdta(:,:,3)
190 
191      ! Boundary condition on emp for free surface option
192      ! -------------------------------------------------
193      CALL lbc_lnk( p_emp, 'T', 1. )
194 
195 
196      ! Closing all files
197      ! -----------------
198 
199      IF( kt == nitend ) CALL flinclo( numflx )
200 
201   END SUBROUTINE flx
Note: See TracBrowser for help on using the repository browser.