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

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

RB:nemo_v1_update_038: first integration of Agrif :

  • add agrif to dynspg_flt_jki.F90
  • cosmetic change of key_AGRIF in key_agrif
  • 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 , 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 .AND. kt /= nit000 )   CALL flinclo(numflx)
121
122         iy = nyear
123         IF(lwp) WRITE (numout,*) iy
124         WRITE(clname,'("flx_1d.nc")')
125#if defined key_agrif
126      if ( .NOT. Agrif_Root() ) then
127         clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname)
128      endif
129#endif         
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),jpi,jpj,1,jpi,20,1,jpj,10,.1,numout)
180                  WRITE(numout,*)
181                  WRITE(numout,*) ' QSR * .1, day: ',ndastp
182                  CALL prihre(flxdta(:,:,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(:,:,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.