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

source: trunk/NEMO/OPA_SRC/SBC/flx_coupled_ice.h90 @ 3

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

Initial revision
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 11.1 KB
Line 
1   !!----------------------------------------------------------------------
2   !!                     ***  flx_coupled_ice.h90  ***
3   !!----------------------------------------------------------------------
4   !!   flx          : define the thermohaline fluxes for the ocean in
5   !!                  coupled ocean/atmosphere case with sea-ice
6   !!----------------------------------------------------------------------
7   !! * Modules used     C A U T I O N  already defined in flxmod.F90
8
9   !! * Module variables
10   LOGICAL :: lfirstf=.TRUE.
11   INTEGER :: nhoridcf, nidcf
12   INTEGER, DIMENSION(jpi*jpj) :: ndexcf
13   !!----------------------------------------------------------------------
14   !!   OPA 9.0 , LODYC-IPSL  (2003)
15   !!----------------------------------------------------------------------
16
17CONTAINS
18
19   SUBROUTINE flx( kt )
20      !!---------------------------------------------------------------------
21      !!                    ***  ROUTINE flx  ***
22      !!                   
23      !! ** Purpose :   provide the thermohaline fluxes (heat and freshwater)
24      !!      to the ocean at each time step.
25      !!
26      !! ** Method  :   Read fluxes from a coupled Atmospheric model
27      !!
28      !! References : The OASIS User Guide, Version 2.0, CERFACS/TR 95/46
29      !!
30      !! History :
31      !!        !         (O. Marti)  Original code
32      !!   8.5  !  02-09  (G. Madec)  F90: Free form and module
33      !!----------------------------------------------------------------------
34      !! * Modules used
35      USE ioipsl
36      USE ice_oce
37      USE cpl_oce
38
39      !! * arguments
40      INTEGER, INTENT( in  ) ::   kt   ! ocean time step
41
42      !! * Local declarations
43      INTEGER :: ji, jj, jf
44      INTEGER :: itm1,isize,iflag,icpliter
45      INTEGER :: info, inuread, index
46      REAL(wp) ::   zfacflx,zfacwat
47      REAL(wp) ::   ztgel,zice
48      REAL(wp) ::   znsolc (jpiglo,jpjglo),zqsrc (jpiglo,jpjglo)
49      REAL(wp) ::   zrunoff(jpiglo,jpjglo),zec   (jpiglo,jpjglo)
50      REAL(wp) ::   zqsrice (jpiglo,jpjglo),zqsrwat (jpiglo,jpjglo)
51      REAL(wp) ::   znsolice(jpiglo,jpjglo),znsolwat(jpiglo,jpjglo)
52      REAL(wp) ::   znsicedt(jpiglo,jpjglo),zevice  (jpiglo,jpjglo)
53      REAL(wp) ::   zevwat  (jpiglo,jpjglo),zpliq   (jpiglo,jpjglo)
54      REAL(wp) ::   zpsol   (jpiglo,jpjglo),zruncot (jpiglo,jpjglo)
55      REAL(wp) ::   zrunriv (jpiglo,jpjglo),zcalving(jpiglo,jpjglo)
56      REAL(wp) ::   zevap (jpiglo,jpjglo)
57      CHARACTER (len=80) ::   clcplfnam
58      REAL(wp) ::   zjulian
59
60      ! Addition for SIPC CASE
61      CHARACTER (len=3) ::   clmodinf       ! Header or not
62      CHARACTER (len=3) ::   cljobnam_r    ! Experiment name in the field brick, if any
63      INTEGER ::   infos(3)          ! infos in the field brick, if any
64      !!---------------------------------------------------------------------
65
66
67      ! Initialization
68      ! --------------
69
70      isize = jpiglo * jpjglo
71      itm1 = ( kt - nit000 + 1 ) - 1
72
73      ! initialisation for output
74
75      IF( lfirstf ) THEN
76         lfirstf = .FALSE.
77         ndexcf(:) = 0
78         clcplfnam = "cpl_oce_flx"
79
80         ! Compute julian date from starting date of the run
81         CALL ymds2ju( nyear, nmonth, nday, 0.e0, zjulian )
82         CALL histbeg(clcplfnam, jpiglo,glamt,jpjglo,gphit,1,jpiglo,1   &
83              ,jpjglo,0,zjulian,rdt,nhoridcf,nidcf)
84         ! no vertical axis
85         DO jf = 1, nflxc2o
86            CALL histdef(nidcf, cpl_readflx(jf),cpl_readflx(jf),   &
87                "-",jpi, jpj, nhoridcf, 1, 1, 1, -99, 32, "inst",   &
88                rdt,rdt)
89         END DO
90         CALL histend(nidcf)
91      ENDIF
92
93      ! caution, I presume that you have good UNIT system from coupler to OPA
94      ! that is :
95      ! watt/m2 for znsolc and zqsrc
96      ! kg/m2/s for evaporation, precipitation and runoff
97      zfacflx = 1.e0
98      ! water should be in kg/m2/day
99      zfacwat = 1.e0  ! 86400.0e0
100
101      ! Test if we couple at the current timestep
102      ! -----------------------------------------
103
104      IF( MOD(kt,nexco) == 1 ) THEN
105
106         ! Test what kind of message passing we are using
107
108         IF(lwp) WRITE(numout,*)
109         IF(lwp) WRITE(numout,*)'FLX: Read fields from CPL, itm1=',itm1
110         IF(lwp) WRITE(numout,*)
111         CALL FLUSH (numout)
112         
113         IF( cchan == 'PIPE' ) THEN
114            ! pipe mode
115
116            ! UNIT number for fields
117
118            inuread = 99
119
120            ! exchanges from to atmosphere=CPL to ocean
121
122            DO jf = 1, nflxc2o
123               ! CALL PIPE_Model_Recv(cpl_readflx(jf), icpliter, numout)
124               OPEN (inuread, FILE=cpl_f_readflx(jf), FORM='UNFORMATTED')
125               IF(jf == 1) CALL locread(cpl_readflx(jf),znsolc ,isize,inuread,iflag,numout)
126               IF(jf == 2) CALL locread(cpl_readflx(jf),zqsrc  ,isize,inuread,iflag,numout)
127               IF(jf == 3) CALL locread(cpl_readflx(jf),zec    ,isize,inuread,iflag,numout)
128               IF(jf == 4) CALL locread(cpl_readflx(jf),zrunoff,isize,inuread,iflag,numout)
129               CLOSE (inuread)
130            END DO
131
132         ELSE IF( cchan == 'SIPC' ) THEN
133            ! SIPC mode
134
135            ! Define IF a header must be encapsulated within the field brick :
136            clmodinf = 'NOT'   ! as $MODINFO in namcouple 
137
138            ! reading of input field non solar flux SONSHLDO
139            index = 1
140            ! CALL SIPC_Read_Model(index, isize, clmodinf, cljobnam_r, infos, znsolc )
141
142            ! reading of input field solar heat flux SOSHFLDO
143            index = 2
144            ! CALL SIPC_Read_Model(index, isize, clmodinf, cljobnam_r, infos, zqsrc  )
145           
146            ! reading of input field water flux SOWAFLDO
147            index = 3
148            ! CALL SIPC_Read_Model(index, isize, clmodinf, cljobnam_r, infos, zec    )
149           
150            ! reading of input field runoff SORUNOFF
151            index = 4
152            ! CALL SIPC_Read_Model(index, isize, clmodinf, cljobnam_r, infos, zrunoff)
153           
154         ELSE IF( cchan == 'CLIM' ) THEN
155            ! CLIM mode
156            IF(lwp) WRITE (numout,*) 'Reading flux from coupler '
157            ! exchanges from atmosphere=CPL to ocean
158            DO jf = 1, nflxc2o
159               IF(jf ==  1) CALL CLIM_Import (cpl_readflx(jf),itm1,zqsrice ,info)
160               IF(jf ==  2) CALL CLIM_Import (cpl_readflx(jf),itm1,zqsrwat ,info)
161               IF(jf ==  3) CALL CLIM_Import (cpl_readflx(jf),itm1,znsolice,info)
162               IF(jf ==  4) CALL CLIM_Import (cpl_readflx(jf),itm1,znsolwat,info)
163               IF(jf ==  5) CALL CLIM_Import (cpl_readflx(jf),itm1,znsicedt,info)
164               IF(jf ==  6) CALL CLIM_Import (cpl_readflx(jf),itm1,zevice  ,info)
165               IF(jf ==  7) CALL CLIM_Import (cpl_readflx(jf),itm1,zevwat  ,info)
166               IF(jf ==  8) CALL CLIM_Import (cpl_readflx(jf),itm1,zpliq   ,info)
167               IF(jf ==  9) CALL CLIM_Import (cpl_readflx(jf),itm1,zpsol   ,info)
168               IF(jf == 10) CALL CLIM_Import (cpl_readflx(jf),itm1,zruncot ,info)
169               IF(jf == 11) CALL CLIM_Import (cpl_readflx(jf),itm1,zrunriv ,info)
170               IF(jf == 12) CALL CLIM_Import (cpl_readflx(jf),itm1,zcalving,info)
171               IF( info /= CLIM_Ok ) THEN
172                  IF(lwp) WRITE(numout,*)'Pb in reading ', cpl_readflx(jf), jf
173                  IF(lwp) WRITE(numout,*)'Couplage itm1 is = ',itm1
174                  IF(lwp) WRITE(numout,*)'CLIM error code is = ', info
175                  IF(lwp) WRITE(numout,*)'STOP in Flx'
176                  CALL abort('flx.coupled.h')
177               ENDIF
178            END DO
179         ENDIF
180
181         ! netcdf outputs
182
183         DO jf = 1, nflxc2o
184            IF(jf ==  1) CALL histwrite(nidcf,cpl_readflx(jf), kt, zqsrice ,jpi*jpj,ndexcf)
185            IF(jf ==  2) CALL histwrite(nidcf,cpl_readflx(jf), kt, zqsrwat ,jpi*jpj,ndexcf)
186            IF(jf ==  3) CALL histwrite(nidcf,cpl_readflx(jf), kt, znsolice,jpi*jpj,ndexcf)
187            IF(jf ==  4) CALL histwrite(nidcf,cpl_readflx(jf), kt, znsolwat,jpi*jpj,ndexcf)
188            IF(jf ==  5) CALL histwrite(nidcf,cpl_readflx(jf), kt, znsicedt,jpi*jpj,ndexcf)
189            IF(jf ==  6) CALL histwrite(nidcf,cpl_readflx(jf), kt, zevice  ,jpi*jpj,ndexcf)
190            IF(jf ==  7) CALL histwrite(nidcf,cpl_readflx(jf), kt, zevwat  ,jpi*jpj,ndexcf)
191            IF(jf ==  8) CALL histwrite(nidcf,cpl_readflx(jf), kt, zpliq   ,jpi*jpj,ndexcf)
192            IF(jf ==  9) CALL histwrite(nidcf,cpl_readflx(jf), kt, zpsol   ,jpi*jpj,ndexcf)
193            IF(jf == 10) CALL histwrite(nidcf,cpl_readflx(jf), kt, zruncot ,jpi*jpj,ndexcf)
194            IF(jf == 11) CALL histwrite(nidcf,cpl_readflx(jf), kt, zrunriv ,jpi*jpj,ndexcf)
195            IF(jf == 12) CALL histwrite(nidcf,cpl_readflx(jf), kt, zcalving,jpi*jpj,ndexcf)
196         END DO
197         CALL histsync(nidcf)
198         IF( nitend-kt < nexco ) CALL histclo(nidcf)
199
200         ! Compute average evaporation
201         DO jj = 1, nlcj
202            DO ji = 1, nlci
203               zevap( mig(ji), mjg(jj)) = zevwat( mig(ji), mjg(jj)) * ( 1.e0 - freeze(ji,jj) )   &
204                  &                     + zevice( mig(ji), mjg(jj)) *          freeze(ji,jj)
205            END DO
206         END DO
207         ! copy in the subdomain
208     
209         DO jj = 1, nlcj
210            DO ji = 1, nlci
211               !  1: Net short wave heat flux on free ocean (positive downward)
212               qsr_oce(ji,jj) =  zqsrwat  ( mig(ji), mjg(jj)) * tmask(ji,jj,1) * zfacflx
213               !  2: Net short wave het flux on sea ice (positive downward)
214               qsr_ice(ji,jj) =  zqsrice  ( mig(ji), mjg(jj)) * tmask(ji,jj,1) * zfacflx
215               !  3: Net longwave heat flux on free ocean (positive downward)
216               qnsr_oce(ji,jj)=  znsolwat ( mig(ji), mjg(jj)) * tmask(ji,jj,1) * zfacflx
217               !  4: Net longwave heat flux on sea ice
218               qnsr_ice(ji,jj)=  znsolice ( mig(ji), mjg(jj)) * tmask(ji,jj,1) * zfacflx
219               !  5: Water flux (liquid precipitation - evaporation)  (positive upward)
220               tprecip(ji,jj) = (  zpliq ( mig(ji), mjg(jj))   &
221                  &                + zpsol ( mig(ji), mjg(jj))   &
222                  &                + zevap ( mig(ji), mjg(jj)) ) * tmask(ji,jj,1) * zfacwat
223               !  6: Solid precipitation  (positive upward)
224               sprecip(ji,jj) =  zpsol    ( mig(ji), mjg(jj)) * tmask(ji,jj,1) * zfacwat
225               !  7: runoff      (positive upward)
226               srunoff(ji,jj) = ( zruncot ( mig(ji), mjg(jj))   &
227                  &              +  zrunriv ( mig(ji), mjg(jj)) ) * tmask(ji,jj,1) * zfacwat
228               !  8: Derivative of non solar heat flux on sea ice
229               dqns_ice(ji,jj) =  znsicedt ( mig(ji), mjg(jj)) * tmask(ji,jj,1) * zfacflx
230               !  13: Iceberg calving (positive upward)
231               calving(ji,jj) =  zcalving ( mig(ji), mjg(jj)) * tmask(ji,jj,1) * zfacwat
232              END DO
233           END DO
234 
235
236         CALL lbc_lnk( qsr_oce , 'T', 1. )
237         CALL lbc_lnk( qsr_ice , 'T', 1. )
238         CALL lbc_lnk( qnsr_oce, 'T', 1. )
239         CALL lbc_lnk( qnsr_ice, 'T', 1. )
240         CALL lbc_lnk( tprecip , 'T', 1. )
241         CALL lbc_lnk( sprecip , 'T', 1. )
242         CALL lbc_lnk( srunoff , 'T', 1. )
243         CALL lbc_lnk( dqns_ice, 'T', 1. )
244         CALL lbc_lnk( calving , 'T', 1. )
245
246      ENDIF
247
248   END SUBROUTINE flx
Note: See TracBrowser for help on using the repository browser.