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

Last change on this file since 172 was 172, checked in by opalod, 19 years ago

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