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

source: trunk/NEMO/OPA_SRC/SBC/flx_coupled_noice.h90 @ 150

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

CL + CT: BUGFIX095: Add "USE flxrnf" module for runoff array
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 7.7 KB
Line 
1   !!----------------------------------------------------------------------
2   !!                   ***  flx_coupled.h90  ***
3   !!----------------------------------------------------------------------
4   !!   flx          : define the thermohaline fluxes for the ocean in
5   !!                  coupled ocean/atmosphere case without sea-ice
6   !!----------------------------------------------------------------------
7   !!   OPA 9.0 , LODYC-IPSL  (2003)
8   !!----------------------------------------------------------------------
9
10CONTAINS
11
12   SUBROUTINE flx ( kt )
13      !!---------------------------------------------------------------------
14      !!                    ***  ROUTINE flx  ***
15      !!           
16      !! ** Purpose :   provide the thermohaline fluxes (heat and freshwater)
17      !!      to the ocean at each time step.
18      !!
19      !! ** Method  :   Read fluxes from a coupled Atmospheric model
20      !!
21      !! References : The OASIS User Guide, Version 2.0, CERFACS/TR 95/46
22      !!
23      !! History :
24      !!        !  92-06  (L.Terray)  Original code
25      !!   8.0  !  96-11  (E.Guilyardi)
26      !!        !  98-04  (M.A Foujols, S. Valcke, M. Imbard)  OASIS2.2
27      !!   8.5  !  02-09  (G. Madec)  F90: Free form and module
28      !!----------------------------------------------------------------------
29      !! CAUTION : not checked for MPP  : J.M.M
30      !!----------------------------------------------------------------------
31      !! * Modules used
32      USE ioipsl                ! NetCDF IPSL library
33      USE cpl_oce               ! coupled ocean-atmosphere variables
34      USE flxrnf                ! ocean runoffs
35
36      !! * arguments
37      INTEGER, INTENT( in  ) ::   kt ! ocean time step
38
39      !! * Local declarations
40      INTEGER  ::   ji, jj, jf
41      INTEGER  ::   itm1, isize, iflag
42!      INTEGER  ::   icpliter
43      INTEGER  ::   info, inuread, index
44
45      REAL(wp) ::   zfacflx,zfacwat
46      REAL(wp), DIMENSION(jpidta,jpjdta) ::   &
47         znsolc  , zqsrc   ,   &  ! ???
48         zrunoff , zec     ,   &  !
49         zqsrice , zqsrwat ,   &  !
50         znsolice, znsolwat,   &  !
51         znsicedt, zevice  ,   &  !
52         zevwat  , zpliq   ,   &  !
53         zpsol   , zruncot ,   &  !
54         zrunriv
55
56      ! Addition for SIPC CASE
57!      CHARACTER (len=3) ::   clmodinf       ! Header or not
58!      CHARACTER (len=3) ::   cljobnam_r    ! Experiment name in the field brick, if any
59      INTEGER infos(3)          ! infos in the field brick, if any
60      !!---------------------------------------------------------------------
61
62
63      ! Initialization
64      ! --------------
65
66      isize = jpiglo * jpjglo
67      itm1 = ( kt - nit000 + 1 ) - 1
68
69      ! caution, I presume that you have good UNIT system from coupler to OPA
70      ! that is :
71      ! watt/m2 for znsolc and zqsrc
72      ! kg/m2/s for evaporation, precipitation and runoff
73
74      zfacflx = 1.
75      zfacwat = 1.
76
77
78      ! Test if we couple at the current timestep
79      ! -----------------------------------------
80
81      IF( MOD( kt, nexco ) == 1 ) THEN
82
83         ! Test what kind of message passing we are using
84
85         IF(lwp) WRITE(numout,*)
86         IF(lwp) WRITE(numout,*)'FLX: Read fields from CPL, itm1=',itm1
87         IF(lwp) WRITE(numout,*)
88         CALL FLUSH (numout)
89         
90         IF( cchan == 'PIPE' ) THEN
91            ! pipe mode
92
93            ! UNIT number for fields
94
95            inuread = 99
96
97            ! exchanges from to atmosphere=CPL to ocean
98
99            DO jf = 1, nflxc2o
100               ! CALL PIPE_Model_Recv(cpl_readflx(jf), icpliter, numout)
101               OPEN (inuread, FILE=cpl_f_readflx(jf), FORM='UNFORMATTED')
102               IF(jf == 1) CALL locread(cpl_readflx(jf),znsolc ,isize,inuread,iflag,numout)
103               IF(jf == 2) CALL locread(cpl_readflx(jf),zqsrc  ,isize,inuread,iflag,numout)
104               IF(jf == 3) CALL locread(cpl_readflx(jf),zec    ,isize,inuread,iflag,numout)
105               IF(jf == 4) CALL locread(cpl_readflx(jf),zrunoff,isize,inuread,iflag,numout)
106               CLOSE (inuread)
107            END DO
108
109         ELSE IF( cchan == 'SIPC' ) THEN
110            ! SIPC mode
111
112            ! Define IF a header must be encapsulated within the field brick :
113            clmodinf = 'NOT'   ! as $MODINFO in namcouple 
114
115            ! reading of input field non solar flux SONSHLDO
116            index = 1
117            ! CALL SIPC_Read_Model(index, isize, clmodinf, cljobnam_r, infos, znsolc )
118
119            ! reading of input field solar heat flux SOSHFLDO
120            index = 2
121            ! CALL SIPC_Read_Model(index, isize, clmodinf, cljobnam_r, infos, zqsrc  )
122           
123            ! reading of input field water flux SOWAFLDO
124            index = 3
125            ! CALL SIPC_Read_Model(index, isize, clmodinf, cljobnam_r, infos, zec    )
126           
127            ! reading of input field runoff SORUNOFF
128            index = 4
129            ! CALL SIPC_Read_Model(index, isize, clmodinf, cljobnam_r, infos, zrunoff)
130           
131         ELSE IF( cchan == 'CLIM' ) THEN
132            ! CLIM mode
133            IF(lwp) WRITE (numout,*) 'Reading flux from coupler '
134            ! exchanges from atmosphere=CPL to ocean
135            DO jf = 1, nflxc2o
136               IF(jf ==  1) CALL CLIM_Import (cpl_readflx(jf),itm1,zqsrice ,info)
137               IF(jf ==  2) CALL CLIM_Import (cpl_readflx(jf),itm1,zqsrwat ,info)
138               IF(jf ==  3) CALL CLIM_Import (cpl_readflx(jf),itm1,znsolice,info)
139               IF(jf ==  4) CALL CLIM_Import (cpl_readflx(jf),itm1,znsolwat,info)
140               IF(jf ==  5) CALL CLIM_Import (cpl_readflx(jf),itm1,znsicedt,info)
141               IF(jf ==  6) CALL CLIM_Import (cpl_readflx(jf),itm1,zevice  ,info)
142               IF(jf ==  7) CALL CLIM_Import (cpl_readflx(jf),itm1,zevwat  ,info)
143               IF(jf ==  8) CALL CLIM_Import (cpl_readflx(jf),itm1,zpliq   ,info)
144               IF(jf ==  9) CALL CLIM_Import (cpl_readflx(jf),itm1,zpsol   ,info)
145               IF(jf == 10) CALL CLIM_Import (cpl_readflx(jf),itm1,zruncot ,info)
146               IF(jf == 11) CALL CLIM_Import (cpl_readflx(jf),itm1,zrunriv ,info)
147               IF( info /= CLIM_Ok ) THEN
148                  IF(lwp) WRITE(numout,*)'Pb in reading ', cpl_readflx(jf), jf
149                  IF(lwp) WRITE(numout,*)'Couplage itm1 is = ',itm1
150                  IF(lwp) WRITE(numout,*)'CLIM error code is = ', info
151                  IF(lwp) WRITE(numout,*)'STOP in Flx'
152                  CALL abort('flx.coupled.h')
153               ENDIF
154            END DO
155         ENDIF
156         
157         ! copy in the subdomain
158
159         DO jj = 1, nlcj
160            DO ji = 1, nlci
161
162               !  qc = total flux add znsolc and zqsrc
163               
164               ! water fluxes input : P-E
165               
166               ! caution, I presume that you have the good UNIT system for OPA
167               ! that is :
168               ! watt/m2 for znsolc and zqsrc
169               ! mm/sec for evaporation, precipitation and runoff
170               ! to give ec and runoff in mm/day
171
172              qc    (ji,jj) = zfacflx * tmask(ji,jj,1) * (        znsolwat( mig(ji), mjg(jj) )   &
173                 &                                              + zqsrwat ( mig(ji), mjg(jj) )   )
174              qsrc  (ji,jj) = zfacflx * tmask(ji,jj,1) *          zqsrwat ( mig(ji), mjg(jj) )
175              ec    (ji,jj) = zfacwat * tmask(ji,jj,1) * ( - ABS( zevwat  ( mig(ji), mjg(jj) ) )   &
176                 &                                         + ABS( zpliq   ( mig(ji), mjg(jj) ) )   &
177                 &                                         + ABS( zpsol   ( mig(ji), mjg(jj) ) )   )
178              runoff(ji,jj) = zfacwat * tmask(ji,jj,1) *     ABS( zruncot ( mig(ji), mjg(jj) )   &
179                 &                                              + zrunriv ( mig(ji), mjg(jj) ) )
180           END DO
181        END DO
182
183      ENDIF
184
185   END SUBROUTINE flx
Note: See TracBrowser for help on using the repository browser.