Changeset 4827
- Timestamp:
- 2014-10-31T12:45:41+01:00 (10 years ago)
- Location:
- branches/UKMO/dev_3841_sbc/NEMOGCM/NEMO/OPA_SRC/SBC
- Files:
-
- 3 added
- 6 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_3841_sbc/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90
r3294 r4827 34 34 USE in_out_manager ! I/O manager 35 35 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 36 USE fld_def 36 37 37 38 IMPLICIT NONE … … 46 47 47 48 LOGICAL, PUBLIC, PARAMETER :: lk_cpl = .TRUE. !: coupled flag 48 INTEGER, PUBLIC :: OASIS_Rcv = 1 !: return code if received field49 INTEGER, PUBLIC :: OASIS_idle = 0 !: return code if nothing done by oasis50 49 INTEGER :: ncomp_id ! id returned by prism_init_comp 51 50 INTEGER :: nerror ! return error code … … 62 61 END TYPE FLD_CPL 63 62 64 TYPE(FLD_CPL), DIMENSION(nmaxfld), PUBLIC :: s rcv, ssnd !: Coupling fields63 TYPE(FLD_CPL), DIMENSION(nmaxfld), PUBLIC :: ssnd !: Coupling fields 65 64 66 65 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: exfld ! Temporary buffer for receiving 66 INTEGER, PUBLIC :: localComm 67 67 68 68 !!---------------------------------------------------------------------- … … 106 106 107 107 108 SUBROUTINE cpl_prism_define( krcv, ksnd )108 SUBROUTINE cpl_prism_define( krcv, ksnd, sd ) 109 109 !!------------------------------------------------------------------- 110 110 !! *** ROUTINE cpl_prism_define *** … … 115 115 !! ** Method : OASIS3 MPI communication 116 116 !!-------------------------------------------------------------------- 117 INTEGER, INTENT(in) :: krcv, ksnd ! Number of received and sent coupling fields 117 INTEGER, INTENT(in) :: krcv, ksnd ! Number of received and sent coupling fields 118 TYPE(FLD), INTENT(in), DIMENSION(:) :: sd ! input field related variables 118 119 ! 119 120 INTEGER :: id_part … … 187 188 ! 188 189 DO ji = 1, krcv 189 IF ( s rcv(ji)%laction) THEN190 DO jc = 1, s rcv(ji)%nct191 IF ( s rcv(ji)%nct .gt. 1 ) THEN192 WRITE(zclname,'( a7, i1)') s rcv(ji)%clname,jc190 IF ( sd(ji)%loasis ) THEN 191 DO jc = 1, sd(ji)%nct 192 IF ( sd(ji)%nct .gt. 1 ) THEN 193 WRITE(zclname,'( a7, i1)') sd(ji)%clvar,jc 193 194 ELSE 194 zclname=s rcv(ji)%clname195 zclname=sd(ji)%clvar 195 196 ENDIF 196 197 WRITE(numout,*) "Define",ji,jc,zclname," for",PRISM_In 197 CALL prism_def_var_proto ( s rcv(ji)%nid(jc), zclname, id_part, (/ 2, 0/), &198 CALL prism_def_var_proto ( sd(ji)%nid(jc), zclname, id_part, (/ 2, 0/), & 198 199 & PRISM_In , ishape , PRISM_REAL, nerror) 199 200 IF ( nerror /= PRISM_Ok ) THEN 200 201 WRITE(numout,*) 'Failed to define transient ', ji, TRIM(zclname) 201 CALL prism_abort_proto ( s rcv(ji)%nid(jc), 'cpl_prism_define', 'Failure in prism_def_var')202 CALL prism_abort_proto ( sd(ji)%nid(jc), 'cpl_prism_define', 'Failure in prism_def_var') 202 203 ENDIF 203 204 END DO … … 256 257 257 258 258 SUBROUTINE cpl_prism_rcv( k id, kstep, pdata, kinfo)259 SUBROUTINE cpl_prism_rcv( kstep, sd ) 259 260 !!--------------------------------------------------------------------- 260 261 !! *** ROUTINE cpl_prism_rcv *** … … 263 264 !! like stresses and fluxes from the coupler or remote application. 264 265 !!---------------------------------------------------------------------- 265 INTEGER , INTENT(in ) :: kid ! variable index in the array266 266 INTEGER , INTENT(in ) :: kstep ! ocean time-step in seconds 267 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pdata ! IN to keep the value if nothing is done 268 INTEGER , INTENT( out) :: kinfo ! OASIS3 info argument 267 TYPE(FLD), INTENT(inout) :: sd ! input field related variables 269 268 !! 270 269 INTEGER :: jc ! local loop index … … 274 273 ! receive local data from OASIS3 on every process 275 274 ! 276 DO jc = 1, s rcv(kid)%nct277 278 CALL prism_get_proto ( s rcv(kid)%nid(jc), kstep, exfld, kinfo )275 DO jc = 1, sd%nct 276 277 CALL prism_get_proto ( sd%nid(jc), kstep, exfld, sd%ninfo ) 279 278 280 279 llaction = .false. 281 IF( kinfo == PRISM_Recvd .OR. kinfo == PRISM_FromRest .OR. &282 kinfo == PRISM_RecvOut .OR. kinfo == PRISM_FromRestOut ) llaction = .TRUE.283 284 IF ( ln_ctl ) WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc)280 IF( sd%ninfo == PRISM_Recvd .OR. sd%ninfo == PRISM_FromRest .OR. & 281 sd%ninfo == PRISM_RecvOut .OR. sd%ninfo == PRISM_FromRestOut ) llaction = .TRUE. 282 283 IF ( ln_ctl ) WRITE(numout,*) "llaction, info, kstep, ivarid: " , llaction, sd%ninfo, kstep, sd%nid(jc) 285 284 286 285 IF ( llaction ) THEN 287 286 288 kinfo = OASIS_Rcv289 pdata(nldi:nlei, nldj:nlej,jc) = exfld(:,:)287 sd%ninfo = OASIS_Rcv 288 sd%fnow(nldi:nlei, nldj:nlej,jc) = exfld(:,:) 290 289 291 290 !--- Fill the overlap areas and extra hallows (mpp) 292 291 !--- check periodicity conditions (all cases) 293 CALL lbc_lnk( pdata(:,:,jc), srcv(kid)%clgrid, srcv(kid)%nsgn )292 CALL lbc_lnk( sd%fnow(:,:,jc), sd%clvgrd, sd%nsgn ) 294 293 295 294 IF ( ln_ctl ) THEN 296 295 WRITE(numout,*) '****************' 297 WRITE(numout,*) 'prism_get_proto: Incoming ', s rcv(kid)%clname298 WRITE(numout,*) 'prism_get_proto: ivarid ' , s rcv(kid)%nid(jc)296 WRITE(numout,*) 'prism_get_proto: Incoming ', sd%clvar 297 WRITE(numout,*) 'prism_get_proto: ivarid ' , sd%nid(jc) 299 298 WRITE(numout,*) 'prism_get_proto: kstep', kstep 300 WRITE(numout,*) 'prism_get_proto: info ', kinfo301 WRITE(numout,*) ' - Minimum value is ', MINVAL( pdata(:,:,jc))302 WRITE(numout,*) ' - Maximum value is ', MAXVAL( pdata(:,:,jc))303 WRITE(numout,*) ' - Sum value is ', SUM( pdata(:,:,jc))299 WRITE(numout,*) 'prism_get_proto: info ', sd%ninfo 300 WRITE(numout,*) ' - Minimum value is ', MINVAL(sd%fnow(:,:,jc)) 301 WRITE(numout,*) ' - Maximum value is ', MAXVAL(sd%fnow(:,:,jc)) 302 WRITE(numout,*) ' - Sum value is ', SUM(sd%fnow(:,:,jc)) 304 303 WRITE(numout,*) '****************' 305 304 ENDIF 306 305 307 306 ELSE 308 kinfo = OASIS_idle307 sd%ninfo = OASIS_idle 309 308 ENDIF 310 309 … … 346 345 !!---------------------------------------------------------------------- 347 346 USE in_out_manager ! I/O manager 347 USE fld_def 348 348 LOGICAL, PUBLIC, PARAMETER :: lk_cpl = .FALSE. !: coupled flag 349 349 PUBLIC cpl_prism_init 350 PUBLIC cpl_prism_rcv 350 351 PUBLIC cpl_prism_finalize 351 352 CONTAINS … … 355 356 WRITE(numout,*) 'cpl_prism_init: Error you sould not be there...' 356 357 END SUBROUTINE cpl_prism_init 358 SUBROUTINE cpl_prism_rcv ( kstep, sd ) 359 INTEGER, INTENT(in ) :: kstep ! ocean time-step in seconds 360 TYPE(FLD), INTENT(inout) :: sd ! input field related variables 361 WRITE(numout,*) 'cpl_prism_rcv: Error you sould not be there...' 362 END SUBROUTINE cpl_prism_rcv 357 363 SUBROUTINE cpl_prism_finalize 358 364 WRITE(numout,*) 'cpl_prism_finalize: Error you sould not be there...' -
branches/UKMO/dev_3841_sbc/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90
r3772 r4827 27 27 USE dom_oce ! ocean space and time domain 28 28 USE phycst ! physical constants 29 USE fldread ! read input fields 29 USE fldread2 ! read input fields 30 USE fld_def 31 USE sbcget 30 32 USE sbc_oce ! Surface boundary condition: ocean fields 31 33 USE cyclone ! Cyclone 10m wind form trac of cyclone centres … … 49 51 PUBLIC blk_ice_core ! routine called in sbc_ice_lim module 50 52 PUBLIC turb_core_2z ! routine calles in sbcblk_mfs module 51 52 INTEGER , PARAMETER :: jpfld = 9 ! maximum number of files to read53 INTEGER , PARAMETER :: jp_wndi = 1 ! index of 10m wind velocity (i-component) (m/s) at T-point54 INTEGER , PARAMETER :: jp_wndj = 2 ! index of 10m wind velocity (j-component) (m/s) at T-point55 INTEGER , PARAMETER :: jp_humi = 3 ! index of specific humidity ( % )56 INTEGER , PARAMETER :: jp_qsr = 4 ! index of solar heat (W/m2)57 INTEGER , PARAMETER :: jp_qlw = 5 ! index of Long wave (W/m2)58 INTEGER , PARAMETER :: jp_tair = 6 ! index of 10m air temperature (Kelvin)59 INTEGER , PARAMETER :: jp_prec = 7 ! index of total precipitation (rain+snow) (Kg/m2/s)60 INTEGER , PARAMETER :: jp_snow = 8 ! index of snow (solid prcipitation) (kg/m2/s)61 INTEGER , PARAMETER :: jp_tdif = 9 ! index of tau diff associated to HF tau (N/m2) at T-point62 53 63 TYPE( FLD), ALLOCATABLE, DIMENSION(:) :: sf ! structure of input fields (file informations, fields read)54 TYPE(MAP_POINTER), ALLOCATABLE, DIMENSION(:) :: nbmap_ptr 64 55 65 56 ! !!! CORE bulk parameters … … 119 110 INTEGER, INTENT(in) :: kt ! ocean time step 120 111 !! 121 INTEGER :: ierror ! return error code 122 INTEGER :: ifpr ! dummy loop indice 123 INTEGER :: jfld ! dummy loop arguments 124 !! 125 CHARACTER(len=100) :: cn_dir ! Root directory for location of core files 126 TYPE(FLD_N), DIMENSION(jpfld) :: slf_i ! array of namelist informations on the fields to read 127 TYPE(FLD_N) :: sn_wndi, sn_wndj, sn_humi, sn_qsr ! informations about the fields to be read 128 TYPE(FLD_N) :: sn_qlw , sn_tair, sn_prec, sn_snow, sn_tdif ! - - 129 NAMELIST/namsbc_core/ cn_dir , ln_2m , ln_taudif, rn_pfac, & 130 & sn_wndi, sn_wndj, sn_humi , sn_qsr , & 131 & sn_qlw , sn_tair, sn_prec , sn_snow, sn_tdif 112 ! NAMELIST/namsbc_core/ cn_dir , ln_2m , ln_taudif, rn_pfac, & 113 ! & sn_wndi, sn_wndj, sn_humi , sn_qsr , & 114 ! & sn_qlw , sn_tair, sn_prec , sn_snow, sn_tdif 132 115 !!--------------------------------------------------------------------- 133 116 … … 135 118 IF( kt == nit000 ) THEN ! First call kt=nit000 ! 136 119 ! ! ====================== ! 137 ! set file information (default values)138 cn_dir = './' ! directory in which the model is executed139 120 ! 140 ! (NB: frequency positive => hours, negative => months)141 ! ! file ! frequency ! variable ! time intep ! clim ! 'yearly' or ! weights ! rotation !142 ! ! name ! (hours) ! name ! (T/F) ! (T/F) ! 'monthly' ! filename ! pairs !143 sn_wndi = FLD_N( 'uwnd10m', 24 , 'u_10' , .false. , .false. , 'yearly' , '' , '' )144 sn_wndj = FLD_N( 'vwnd10m', 24 , 'v_10' , .false. , .false. , 'yearly' , '' , '' )145 sn_qsr = FLD_N( 'qsw' , 24 , 'qsw' , .false. , .false. , 'yearly' , '' , '' )146 sn_qlw = FLD_N( 'qlw' , 24 , 'qlw' , .false. , .false. , 'yearly' , '' , '' )147 sn_tair = FLD_N( 'tair10m', 24 , 't_10' , .false. , .false. , 'yearly' , '' , '' )148 sn_humi = FLD_N( 'humi10m', 24 , 'q_10' , .false. , .false. , 'yearly' , '' , '' )149 sn_prec = FLD_N( 'precip' , -1 , 'precip' , .true. , .false. , 'yearly' , '' , '' )150 sn_snow = FLD_N( 'snow' , -1 , 'snow' , .true. , .false. , 'yearly' , '' , '' )151 sn_tdif = FLD_N( 'taudif' , 24 , 'taudif' , .true. , .false. , 'yearly' , '' , '' )152 !153 REWIND( numnam ) ! read in namlist namsbc_core154 READ ( numnam, namsbc_core )155 121 ! ! check: do we plan to use ln_dm2dc with non-daily forcing? 156 IF( ln_dm2dc .AND. s n_qsr%nfreqh /= 24 ) &122 IF( ln_dm2dc .AND. sf(jp_qsroce)%nfreqh /= 24 ) & 157 123 & CALL ctl_stop( 'sbc_blk_core: ln_dm2dc can be activated only with daily short-wave forcing' ) 158 IF( ln_dm2dc .AND. s n_qsr%ln_tint ) THEN124 IF( ln_dm2dc .AND. sf(jp_qsroce)%ln_tint ) THEN 159 125 CALL ctl_warn( 'sbc_blk_core: ln_dm2dc is taking care of the temporal interpolation of daily qsr', & 160 126 & ' ==> We force time interpolation = .false. for qsr' ) 161 s n_qsr%ln_tint = .false.127 sf(jp_qsroce)%ln_tint = .false. 162 128 ENDIF 163 ! ! store namelist information in an array164 slf_i(jp_wndi) = sn_wndi ; slf_i(jp_wndj) = sn_wndj165 slf_i(jp_qsr ) = sn_qsr ; slf_i(jp_qlw ) = sn_qlw166 slf_i(jp_tair) = sn_tair ; slf_i(jp_humi) = sn_humi167 slf_i(jp_prec) = sn_prec ; slf_i(jp_snow) = sn_snow168 slf_i(jp_tdif) = sn_tdif169 129 ! 170 130 lhftau = ln_taudif ! do we use HF tau information? 171 jfld = jpfld - COUNT( (/.NOT. lhftau/) )172 !173 ALLOCATE( sf(jfld), STAT=ierror ) ! set sf structure174 IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_blk_core: unable to allocate sf structure' )175 DO ifpr= 1, jfld176 ALLOCATE( sf(ifpr)%fnow(jpi,jpj,1) )177 IF( slf_i(ifpr)%ln_tint ) ALLOCATE( sf(ifpr)%fdta(jpi,jpj,1,2) )178 END DO179 ! ! fill sf with slf_i and control print180 CALL fld_fill( sf, slf_i, cn_dir, 'sbc_blk_core', 'flux formulation for ocean surface boundary condition', 'namsbc_core' )181 131 ! 182 132 sfx(:,:) = 0._wp ! salt flux; zero unless ice is present (computed in limsbc(_2).F90) 183 133 ! 184 134 ENDIF 185 186 CALL fld_read( kt, nn_fsbc, sf ) ! input fields provided at the current time-step187 188 135 ! ! compute the surface ocean fluxes using CORE bulk formulea 189 136 IF( MOD( kt - 1, nn_fsbc ) == 0 ) CALL blk_oce_core( kt, sf, sst_m, ssu_m, ssv_m ) … … 192 139 IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN 193 140 qlw_ice(:,:,1) = sf(jp_qlw)%fnow(:,:,1) 194 qsr_ice(:,:,1) = sf(jp_qsr )%fnow(:,:,1)141 qsr_ice(:,:,1) = sf(jp_qsroce)%fnow(:,:,1) 195 142 tatm_ice(:,:) = sf(jp_tair)%fnow(:,:,1) 196 143 qatm_ice(:,:) = sf(jp_humi)%fnow(:,:,1) … … 298 245 ! ocean albedo assumed to be constant + modify now Qsr to include the diurnal cycle ! Short Wave 299 246 zztmp = 1. - albo 300 IF( ln_dm2dc ) THEN ; qsr(:,:) = zztmp * sbc_dcy( sf(jp_qsr )%fnow(:,:,1) ) * tmask(:,:,1)301 ELSE ; qsr(:,:) = zztmp * sf(jp_qsr )%fnow(:,:,1) * tmask(:,:,1)247 IF( ln_dm2dc ) THEN ; qsr(:,:) = zztmp * sbc_dcy( sf(jp_qsroce)%fnow(:,:,1) ) * tmask(:,:,1) 248 ELSE ; qsr(:,:) = zztmp * sf(jp_qsroce)%fnow(:,:,1) * tmask(:,:,1) 302 249 ENDIF 303 250 !CDIR COLLAPSE -
branches/UKMO/dev_3841_sbc/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r3680 r4827 26 26 USE sbcdcy ! surface boundary condition: diurnal cycle 27 27 USE phycst ! physical constants 28 USE fldread2, ONLY: fld_fill2 ! read input fields 29 USE fld_def 30 USE sbcget 28 31 #if defined key_lim3 29 32 USE par_ice ! ice parameters … … 53 56 #endif 54 57 USE diaar5, ONLY : lk_diaar5 55 #if defined key_cice 56 USE ice_domain_size, only: ncat 57 #endif 58 58 59 IMPLICIT NONE 59 60 PRIVATE … … 63 64 PUBLIC sbc_cpl_ice_tau ! routine called by sbc_ice_lim(_2).F90 64 65 PUBLIC sbc_cpl_ice_flx ! routine called by sbc_ice_lim(_2).F90 65 66 INTEGER, PARAMETER :: jpr_otx1 = 1 ! 3 atmosphere-ocean stress components on grid 167 INTEGER, PARAMETER :: jpr_oty1 = 2 !68 INTEGER, PARAMETER :: jpr_otz1 = 3 !69 INTEGER, PARAMETER :: jpr_otx2 = 4 ! 3 atmosphere-ocean stress components on grid 270 INTEGER, PARAMETER :: jpr_oty2 = 5 !71 INTEGER, PARAMETER :: jpr_otz2 = 6 !72 INTEGER, PARAMETER :: jpr_itx1 = 7 ! 3 atmosphere-ice stress components on grid 173 INTEGER, PARAMETER :: jpr_ity1 = 8 !74 INTEGER, PARAMETER :: jpr_itz1 = 9 !75 INTEGER, PARAMETER :: jpr_itx2 = 10 ! 3 atmosphere-ice stress components on grid 276 INTEGER, PARAMETER :: jpr_ity2 = 11 !77 INTEGER, PARAMETER :: jpr_itz2 = 12 !78 INTEGER, PARAMETER :: jpr_qsroce = 13 ! Qsr above the ocean79 INTEGER, PARAMETER :: jpr_qsrice = 14 ! Qsr above the ice80 INTEGER, PARAMETER :: jpr_qsrmix = 1581 INTEGER, PARAMETER :: jpr_qnsoce = 16 ! Qns above the ocean82 INTEGER, PARAMETER :: jpr_qnsice = 17 ! Qns above the ice83 INTEGER, PARAMETER :: jpr_qnsmix = 1884 INTEGER, PARAMETER :: jpr_rain = 19 ! total liquid precipitation (rain)85 INTEGER, PARAMETER :: jpr_snow = 20 ! solid precipitation over the ocean (snow)86 INTEGER, PARAMETER :: jpr_tevp = 21 ! total evaporation87 INTEGER, PARAMETER :: jpr_ievp = 22 ! solid evaporation (sublimation)88 INTEGER, PARAMETER :: jpr_sbpr = 23 ! sublimation - liquid precipitation - solid precipitation89 INTEGER, PARAMETER :: jpr_semp = 24 ! solid freshwater budget (sublimation - snow)90 INTEGER, PARAMETER :: jpr_oemp = 25 ! ocean freshwater budget (evap - precip)91 INTEGER, PARAMETER :: jpr_w10m = 26 ! 10m wind92 INTEGER, PARAMETER :: jpr_dqnsdt = 27 ! d(Q non solar)/d(temperature)93 INTEGER, PARAMETER :: jpr_rnf = 28 ! runoffs94 INTEGER, PARAMETER :: jpr_cal = 29 ! calving95 INTEGER, PARAMETER :: jpr_taum = 30 ! wind stress module96 INTEGER, PARAMETER :: jpr_co2 = 3197 INTEGER, PARAMETER :: jpr_topm = 32 ! topmeltn98 INTEGER, PARAMETER :: jpr_botm = 33 ! botmeltn99 INTEGER, PARAMETER :: jprcv = 33 ! total number of fields received100 66 101 67 INTEGER, PARAMETER :: jps_fice = 1 ! ice fraction … … 124 90 CHARACTER(len = 32) :: clvgrd ! grids on which is located the vector fields 125 91 END TYPE FLD_C 92 93 126 94 ! Send to the atmosphere ! 127 95 TYPE(FLD_C) :: sn_snd_temp, sn_snd_alb, sn_snd_thick, sn_snd_crt, sn_snd_co2 … … 129 97 TYPE(FLD_C) :: sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau, sn_rcv_dqnsdt, sn_rcv_qsr, sn_rcv_qns, sn_rcv_emp, sn_rcv_rnf 130 98 TYPE(FLD_C) :: sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2 131 132 TYPE :: DYNARR 133 REAL(wp), POINTER, DIMENSION(:,:,:) :: z3 134 END TYPE DYNARR 135 136 TYPE( DYNARR ), SAVE, DIMENSION(jprcv) :: frcv ! all fields recieved from the atmosphere 99 TYPE(FLD_N) :: sn_wndi, sn_wndj, sn_otx1, sn_oty1, sn_otz1, sn_otx2, sn_oty2, sn_otz2, sn_itx1, sn_ity1, sn_itz1, sn_itx2, sn_ity2, sn_itz2 137 100 138 101 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: albedo_oce_mix ! ocean albedo sent to atmosphere (mix clear/overcast sky) 139 140 INTEGER , ALLOCATABLE, SAVE, DIMENSION( :) :: nrcvinfo ! OASIS info argument141 102 142 103 #if ! defined key_lim2 && ! defined key_lim3 … … 145 106 #endif 146 107 147 #if defined key_cice 148 INTEGER, PARAMETER :: jpl = ncat 149 #elif ! defined key_lim2 && ! defined key_lim3 150 INTEGER, PARAMETER :: jpl = 1 108 #if ! defined key_cice && ! defined key_lim2 && ! defined key_lim3 151 109 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_ice 152 110 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qsr_ice … … 183 141 ierr(:) = 0 184 142 ! 185 ALLOCATE( albedo_oce_mix(jpi,jpj), nrcvinfo(jprcv),STAT=ierr(1) )143 ALLOCATE( albedo_oce_mix(jpi,jpj), STAT=ierr(1) ) 186 144 ! 187 145 #if ! defined key_lim2 && ! defined key_lim3 … … 220 178 INTEGER, INTENT(in) :: k_ice ! ice management in the sbc (=0/1/2/3) 221 179 !! 222 INTEGER :: jn ! dummy loop index180 INTEGER :: jn ! dummy loop index 223 181 REAL(wp), POINTER, DIMENSION(:,:) :: zacs, zaos 224 182 !! … … 297 255 ! Define the receive interface ! 298 256 ! ================================ ! 299 nrcvinfo(:) = OASIS_idle ! needed by nrcvinfo(jpr_otx1) if we do not receive ocean stress 300 301 ! for each field: define the OASIS name (srcv(:)%clname) 302 ! define receive or not from the namelist parameters (srcv(:)%laction) 303 ! define the north fold type of lbc (srcv(:)%nsgn) 304 305 ! default definitions of srcv 306 srcv(:)%laction = .FALSE. ; srcv(:)%clgrid = 'T' ; srcv(:)%nsgn = 1. ; srcv(:)%nct = 1 307 308 ! ! ------------------------- ! 309 ! ! ice and ocean wind stress ! 310 ! ! ------------------------- ! 311 ! ! Name 312 srcv(jpr_otx1)%clname = 'O_OTaux1' ! 1st ocean component on grid ONE (T or U) 313 srcv(jpr_oty1)%clname = 'O_OTauy1' ! 2nd - - - - 314 srcv(jpr_otz1)%clname = 'O_OTauz1' ! 3rd - - - - 315 srcv(jpr_otx2)%clname = 'O_OTaux2' ! 1st ocean component on grid TWO (V) 316 srcv(jpr_oty2)%clname = 'O_OTauy2' ! 2nd - - - - 317 srcv(jpr_otz2)%clname = 'O_OTauz2' ! 3rd - - - - 318 ! 319 srcv(jpr_itx1)%clname = 'O_ITaux1' ! 1st ice component on grid ONE (T, F, I or U) 320 srcv(jpr_ity1)%clname = 'O_ITauy1' ! 2nd - - - - 321 srcv(jpr_itz1)%clname = 'O_ITauz1' ! 3rd - - - - 322 srcv(jpr_itx2)%clname = 'O_ITaux2' ! 1st ice component on grid TWO (V) 323 srcv(jpr_ity2)%clname = 'O_ITauy2' ! 2nd - - - - 324 srcv(jpr_itz2)%clname = 'O_ITauz2' ! 3rd - - - - 325 ! 257 326 258 ! Vectors: change of sign at north fold ONLY if on the local grid 327 IF( TRIM( sn_rcv_tau%clvor ) == 'local grid' ) s rcv(jpr_otx1:jpr_itz2)%nsgn = -1.259 IF( TRIM( sn_rcv_tau%clvor ) == 'local grid' ) sf(jp_otx1:jp_itz2)%nsgn = -1. 328 260 329 ! ! Set grid and action330 SELECT CASE( TRIM( sn_rcv_tau%clvgrd ) ) ! 'T', 'U,V', 'U,V,I', 'U,V,F', 'T,I', 'T,F', or 'T,U,V'331 CASE( 'T' )332 srcv(jpr_otx1:jpr_itz2)%clgrid = 'T' ! oce and ice components given at T-point333 srcv(jpr_otx1:jpr_otz1)%laction = .TRUE. ! receive oce components on grid 1334 srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1335 CASE( 'U,V' )336 srcv(jpr_otx1:jpr_otz1)%clgrid = 'U' ! oce components given at U-point337 srcv(jpr_otx2:jpr_otz2)%clgrid = 'V' ! and V-point338 srcv(jpr_itx1:jpr_itz1)%clgrid = 'U' ! ice components given at U-point339 srcv(jpr_itx2:jpr_itz2)%clgrid = 'V' ! and V-point340 srcv(jpr_otx1:jpr_itz2)%laction = .TRUE. ! receive oce and ice components on both grid 1 & 2341 CASE( 'U,V,T' )342 srcv(jpr_otx1:jpr_otz1)%clgrid = 'U' ! oce components given at U-point343 srcv(jpr_otx2:jpr_otz2)%clgrid = 'V' ! and V-point344 srcv(jpr_itx1:jpr_itz1)%clgrid = 'T' ! ice components given at T-point345 srcv(jpr_otx1:jpr_otz2)%laction = .TRUE. ! receive oce components on grid 1 & 2346 srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1 only347 CASE( 'U,V,I' )348 srcv(jpr_otx1:jpr_otz1)%clgrid = 'U' ! oce components given at U-point349 srcv(jpr_otx2:jpr_otz2)%clgrid = 'V' ! and V-point350 srcv(jpr_itx1:jpr_itz1)%clgrid = 'I' ! ice components given at I-point351 srcv(jpr_otx1:jpr_otz2)%laction = .TRUE. ! receive oce components on grid 1 & 2352 srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1 only353 CASE( 'U,V,F' )354 srcv(jpr_otx1:jpr_otz1)%clgrid = 'U' ! oce components given at U-point355 srcv(jpr_otx2:jpr_otz2)%clgrid = 'V' ! and V-point356 srcv(jpr_itx1:jpr_itz1)%clgrid = 'F' ! ice components given at F-point357 srcv(jpr_otx1:jpr_otz2)%laction = .TRUE. ! receive oce components on grid 1 & 2358 srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1 only359 CASE( 'T,I' )360 srcv(jpr_otx1:jpr_itz2)%clgrid = 'T' ! oce and ice components given at T-point361 srcv(jpr_itx1:jpr_itz1)%clgrid = 'I' ! ice components given at I-point362 srcv(jpr_otx1:jpr_otz1)%laction = .TRUE. ! receive oce components on grid 1363 srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1364 CASE( 'T,F' )365 srcv(jpr_otx1:jpr_itz2)%clgrid = 'T' ! oce and ice components given at T-point366 srcv(jpr_itx1:jpr_itz1)%clgrid = 'F' ! ice components given at F-point367 srcv(jpr_otx1:jpr_otz1)%laction = .TRUE. ! receive oce components on grid 1368 srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1369 CASE( 'T,U,V' )370 srcv(jpr_otx1:jpr_otz1)%clgrid = 'T' ! oce components given at T-point371 srcv(jpr_itx1:jpr_itz1)%clgrid = 'U' ! ice components given at U-point372 srcv(jpr_itx2:jpr_itz2)%clgrid = 'V' ! and V-point373 srcv(jpr_otx1:jpr_otz1)%laction = .TRUE. ! receive oce components on grid 1 only374 srcv(jpr_itx1:jpr_itz2)%laction = .TRUE. ! receive ice components on grid 1 & 2375 CASE default376 CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_tau%clvgrd' )377 END SELECT378 !379 IF( TRIM( sn_rcv_tau%clvref ) == 'spherical' ) & ! spherical: 3rd component not received380 & srcv( (/jpr_otz1, jpr_otz2, jpr_itz1, jpr_itz2/) )%laction = .FALSE.381 261 ! 382 262 IF( TRIM( sn_rcv_tau%clvor ) == 'local grid' ) THEN ! already on local grid -> no need of the second grid 383 srcv(jpr_otx2:jpr_otz2)%laction = .FALSE. 384 srcv(jpr_itx2:jpr_itz2)%laction = .FALSE. 385 srcv(jpr_oty1)%clgrid = srcv(jpr_oty2)%clgrid ! not needed but cleaner... 386 srcv(jpr_ity1)%clgrid = srcv(jpr_ity2)%clgrid ! not needed but cleaner... 387 ENDIF 388 ! 389 IF( TRIM( sn_rcv_tau%cldes ) /= 'oce and ice' ) THEN ! 'oce and ice' case ocean stress on ocean mesh used 390 srcv(jpr_itx1:jpr_itz2)%laction = .FALSE. ! ice components not received 391 srcv(jpr_itx1)%clgrid = 'U' ! ocean stress used after its transformation 392 srcv(jpr_ity1)%clgrid = 'V' ! i.e. it is always at U- & V-points for i- & j-comp. resp. 393 ENDIF 394 395 ! ! ------------------------- ! 396 ! ! freshwater budget ! E-P 397 ! ! ------------------------- ! 398 ! we suppose that atmosphere modele do not make the difference between precipiration (liquide or solid) 399 ! over ice of free ocean within the same atmospheric cell.cd 400 srcv(jpr_rain)%clname = 'OTotRain' ! Rain = liquid precipitation 401 srcv(jpr_snow)%clname = 'OTotSnow' ! Snow = solid precipitation 402 srcv(jpr_tevp)%clname = 'OTotEvap' ! total evaporation (over oce + ice sublimation) 403 srcv(jpr_ievp)%clname = 'OIceEvap' ! evaporation over ice = sublimation 404 srcv(jpr_sbpr)%clname = 'OSubMPre' ! sublimation - liquid precipitation - solid precipitation 405 srcv(jpr_semp)%clname = 'OISubMSn' ! ice solid water budget = sublimation - solid precipitation 406 srcv(jpr_oemp)%clname = 'OOEvaMPr' ! ocean water budget = ocean Evap - ocean precip 407 SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) 408 CASE( 'oce only' ) ; srcv( jpr_oemp )%laction = .TRUE. 409 CASE( 'conservative' ) ; srcv( (/jpr_rain, jpr_snow, jpr_ievp, jpr_tevp/) )%laction = .TRUE. 410 CASE( 'oce and ice' ) ; srcv( (/jpr_ievp, jpr_sbpr, jpr_semp, jpr_oemp/) )%laction = .TRUE. 411 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_emp%cldes' ) 412 END SELECT 413 414 ! ! ------------------------- ! 415 ! ! Runoffs & Calving ! 416 ! ! ------------------------- ! 417 srcv(jpr_rnf )%clname = 'O_Runoff' ; IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) srcv(jpr_rnf)%laction = .TRUE. 418 ! This isn't right - really just want ln_rnf_emp changed 419 ! IF( TRIM( sn_rcv_rnf%cldes ) == 'climato' ) THEN ; ln_rnf = .TRUE. 420 ! ELSE ; ln_rnf = .FALSE. 421 ! ENDIF 422 srcv(jpr_cal )%clname = 'OCalving' ; IF( TRIM( sn_rcv_cal%cldes ) == 'coupled' ) srcv(jpr_cal)%laction = .TRUE. 423 424 ! ! ------------------------- ! 425 ! ! non solar radiation ! Qns 426 ! ! ------------------------- ! 427 srcv(jpr_qnsoce)%clname = 'O_QnsOce' 428 srcv(jpr_qnsice)%clname = 'O_QnsIce' 429 srcv(jpr_qnsmix)%clname = 'O_QnsMix' 430 SELECT CASE( TRIM( sn_rcv_qns%cldes ) ) 431 CASE( 'oce only' ) ; srcv( jpr_qnsoce )%laction = .TRUE. 432 CASE( 'conservative' ) ; srcv( (/jpr_qnsice, jpr_qnsmix/) )%laction = .TRUE. 433 CASE( 'oce and ice' ) ; srcv( (/jpr_qnsice, jpr_qnsoce/) )%laction = .TRUE. 434 CASE( 'mixed oce-ice' ) ; srcv( jpr_qnsmix )%laction = .TRUE. 435 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_qns%cldes' ) 436 END SELECT 437 IF( TRIM( sn_rcv_qns%cldes ) == 'mixed oce-ice' .AND. jpl > 1 ) & 438 CALL ctl_stop( 'sbc_cpl_init: sn_rcv_qns%cldes not currently allowed to be mixed oce-ice for multi-category ice' ) 439 ! ! ------------------------- ! 440 ! ! solar radiation ! Qsr 441 ! ! ------------------------- ! 442 srcv(jpr_qsroce)%clname = 'O_QsrOce' 443 srcv(jpr_qsrice)%clname = 'O_QsrIce' 444 srcv(jpr_qsrmix)%clname = 'O_QsrMix' 445 SELECT CASE( TRIM( sn_rcv_qsr%cldes ) ) 446 CASE( 'oce only' ) ; srcv( jpr_qsroce )%laction = .TRUE. 447 CASE( 'conservative' ) ; srcv( (/jpr_qsrice, jpr_qsrmix/) )%laction = .TRUE. 448 CASE( 'oce and ice' ) ; srcv( (/jpr_qsrice, jpr_qsroce/) )%laction = .TRUE. 449 CASE( 'mixed oce-ice' ) ; srcv( jpr_qsrmix )%laction = .TRUE. 450 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_qsr%cldes' ) 451 END SELECT 452 IF( TRIM( sn_rcv_qsr%cldes ) == 'mixed oce-ice' .AND. jpl > 1 ) & 453 CALL ctl_stop( 'sbc_cpl_init: sn_rcv_qsr%cldes not currently allowed to be mixed oce-ice for multi-category ice' ) 454 ! ! ------------------------- ! 455 ! ! non solar sensitivity ! d(Qns)/d(T) 456 ! ! ------------------------- ! 457 srcv(jpr_dqnsdt)%clname = 'O_dQnsdT' 458 IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'coupled' ) srcv(jpr_dqnsdt)%laction = .TRUE. 459 ! 460 ! non solar sensitivity mandatory for LIM ice model 461 IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. k_ice /= 0 .AND. k_ice /= 4) & 462 CALL ctl_stop( 'sbc_cpl_init: sn_rcv_dqnsdt%cldes must be coupled in namsbc_cpl namelist' ) 463 ! non solar sensitivity mandatory for mixed oce-ice solar radiation coupling technique 464 IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. TRIM( sn_rcv_qns%cldes ) == 'mixed oce-ice' ) & 465 CALL ctl_stop( 'sbc_cpl_init: namsbc_cpl namelist mismatch between sn_rcv_qns%cldes and sn_rcv_dqnsdt%cldes' ) 466 ! ! ------------------------- ! 467 ! ! Ice Qsr penetration ! 468 ! ! ------------------------- ! 469 ! fraction of net shortwave radiation which is not absorbed in the thin surface layer 470 ! and penetrates inside the ice cover ( Maykut and Untersteiner, 1971 ; Elbert anbd Curry, 1993 ) 471 ! Coupled case: since cloud cover is not received from atmosphere 472 ! ===> defined as constant value -> definition done in sbc_cpl_init 473 fr1_i0(:,:) = 0.18 474 fr2_i0(:,:) = 0.82 475 ! ! ------------------------- ! 476 ! ! 10m wind module ! 477 ! ! ------------------------- ! 478 srcv(jpr_w10m)%clname = 'O_Wind10' ; IF( TRIM(sn_rcv_w10m%cldes ) == 'coupled' ) srcv(jpr_w10m)%laction = .TRUE. 479 ! 480 ! ! ------------------------- ! 481 ! ! wind stress module ! 482 ! ! ------------------------- ! 483 srcv(jpr_taum)%clname = 'O_TauMod' ; IF( TRIM(sn_rcv_taumod%cldes) == 'coupled' ) srcv(jpr_taum)%laction = .TRUE. 484 lhftau = srcv(jpr_taum)%laction 485 486 ! ! ------------------------- ! 487 ! ! Atmospheric CO2 ! 488 ! ! ------------------------- ! 489 srcv(jpr_co2 )%clname = 'O_AtmCO2' ; IF( TRIM(sn_rcv_co2%cldes ) == 'coupled' ) srcv(jpr_co2 )%laction = .TRUE. 490 ! ! ------------------------- ! 491 ! ! topmelt and botmelt ! 492 ! ! ------------------------- ! 493 srcv(jpr_topm )%clname = 'OTopMlt' 494 srcv(jpr_botm )%clname = 'OBotMlt' 495 IF( TRIM(sn_rcv_iceflx%cldes) == 'coupled' ) THEN 496 IF ( TRIM( sn_rcv_iceflx%clcat ) == 'yes' ) THEN 497 srcv(jpr_topm:jpr_botm)%nct = jpl 498 ELSE 499 CALL ctl_stop( 'sbc_cpl_init: sn_rcv_iceflx%clcat should always be set to yes currently' ) 500 ENDIF 501 srcv(jpr_topm:jpr_botm)%laction = .TRUE. 502 ENDIF 503 504 ! Allocate all parts of frcv used for received fields 505 DO jn = 1, jprcv 506 IF ( srcv(jn)%laction ) ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) ) 507 END DO 508 ! Allocate taum part of frcv which is used even when not received as coupling field 509 IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jn)%nct) ) 263 sf(jp_oty1)%clvgrd = sf(jp_oty2)%clvgrd ! not needed but cleaner... 264 sf(jp_ity1)%clvgrd = sf(jp_ity2)%clvgrd ! not needed but cleaner... 265 ENDIF 266 ! 510 267 511 268 ! ================================ ! … … 621 378 ! ================================ ! 622 379 623 CALL cpl_prism_define(jp rcv, jpsnd)624 ! 625 IF( ln_dm2dc .AND. ( cpl_prism_freq( jp r_qsroce ) + cpl_prism_freq( jpr_qsrmix ) /= 86400 ) ) &380 CALL cpl_prism_define(jpfld, jpsnd, sf) 381 ! 382 IF( ln_dm2dc .AND. ( cpl_prism_freq( jp_qsroce ) + cpl_prism_freq( jp_qsrmix ) /= 86400 ) ) & 626 383 & CALL ctl_stop( 'sbc_cpl_init: diurnal cycle reconstruction (ln_dm2dc) needs daily couping for solar radiation' ) 627 384 … … 640 397 !! provide the ocean heat and freshwater fluxes. 641 398 !! 642 !! ** Method : - Receive all the atmospheric fields (stored in frcvarray). called at each time step.643 !! OASIS controls if there is something do receive or not. n rcvinfo contains the info399 !! ** Method : - Receive all the atmospheric fields (stored in sf array). called at each time step. 400 !! OASIS controls if there is something do receive or not. ninfo contains the info 644 401 !! to know if the field was really received or not 645 402 !! … … 683 440 LOGICAL :: llnewtx, llnewtau ! update wind stress components and module?? 684 441 INTEGER :: ji, jj, jn ! dummy loop indices 685 INTEGER :: isec ! number of seconds since nit000 (assuming rdttra did not change since nit000)686 442 REAL(wp) :: zcumulneg, zcumulpos ! temporary scalars 687 443 REAL(wp) :: zcoef ! temporary scalar … … 699 455 700 456 ! ! Receive all the atmos. fields (including ice information) 701 isec = ( kt - nit000 ) * NINT( rdttra(1) ) ! date of exchanges702 DO jn = 1, jprcv ! received fields sent by the atmosphere703 IF( srcv(jn)%laction ) CALL cpl_prism_rcv( jn, isec, frcv(jn)%z3, nrcvinfo(jn) )704 END DO705 706 457 ! ! ========================= ! 707 IF( s rcv(jpr_otx1)%laction) THEN ! ocean stress components !458 IF( sf(jp_otx1)%loasis ) THEN ! ocean stress components ! 708 459 ! ! ========================= ! 709 ! define frcv(jpr_otx1)%z3(:,:,1) and frcv(jpr_oty1)%z3(:,:,1): stress at U/V point along model grid460 ! define sf(jp_otx1)%fnow(:,:,1) and sf(jp_oty1)%fnow(:,:,1): stress at U/V point along model grid 710 461 ! => need to be done only when we receive the field 711 IF( nrcvinfo(jpr_otx1)== OASIS_Rcv ) THEN462 IF( sf(jp_otx1)%ninfo == OASIS_Rcv ) THEN 712 463 ! 713 464 IF( TRIM( sn_rcv_tau%clvref ) == 'cartesian' ) THEN ! 2 components on the sphere 714 465 ! ! (cartesian to spherical -> 3 to 2 components) 715 466 ! 716 CALL geo2oce( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), frcv(jpr_otz1)%z3(:,:,1), &717 & s rcv(jpr_otx1)%clgrid, ztx, zty )718 frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st comp. on the 1st grid719 frcv(jpr_oty1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd comp. on the 1st grid467 CALL geo2oce( sf(jp_otx1)%fnow(:,:,1), sf(jp_oty1)%fnow(:,:,1), sf(jp_otz1)%fnow(:,:,1), & 468 & sf(jp_otx1)%clvgrd, ztx, zty ) 469 sf(jp_otx1)%fnow(:,:,1) = ztx(:,:) ! overwrite 1st comp. on the 1st grid 470 sf(jp_oty1)%fnow(:,:,1) = zty(:,:) ! overwrite 2nd comp. on the 1st grid 720 471 ! 721 IF( s rcv(jpr_otx2)%laction) THEN722 CALL geo2oce( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), frcv(jpr_otz2)%z3(:,:,1), &723 & s rcv(jpr_otx2)%clgrid, ztx, zty )724 frcv(jpr_otx2)%z3(:,:,1) = ztx(:,:) ! overwrite 1st comp. on the 2nd grid725 frcv(jpr_oty2)%z3(:,:,1) = zty(:,:) ! overwrite 2nd comp. on the 2nd grid472 IF( sf(jp_otx2)%loasis ) THEN 473 CALL geo2oce( sf(jp_otx2)%fnow(:,:,1), sf(jp_oty2)%fnow(:,:,1), sf(jp_otz2)%fnow(:,:,1), & 474 & sf(jp_otx2)%clvgrd, ztx, zty ) 475 sf(jp_otx2)%fnow(:,:,1) = ztx(:,:) ! overwrite 1st comp. on the 2nd grid 476 sf(jp_oty2)%fnow(:,:,1) = zty(:,:) ! overwrite 2nd comp. on the 2nd grid 726 477 ENDIF 727 478 ! … … 730 481 IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN ! 2 components oriented along the local grid 731 482 ! ! (geographical to local grid -> rotate the components) 732 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->i', ztx )733 IF( s rcv(jpr_otx2)%laction) THEN734 CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty )483 CALL rot_rep( sf(jp_otx1)%fnow(:,:,1), sf(jp_oty1)%fnow(:,:,1), sf(jp_otx1)%clvgrd, 'en->i', ztx ) 484 IF( sf(jp_otx2)%loasis ) THEN 485 CALL rot_rep( sf(jp_otx2)%fnow(:,:,1), sf(jp_oty2)%fnow(:,:,1), sf(jp_otx2)%clvgrd, 'en->j', zty ) 735 486 ELSE 736 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty )487 CALL rot_rep( sf(jp_otx1)%fnow(:,:,1), sf(jp_oty1)%fnow(:,:,1), sf(jp_otx1)%clvgrd, 'en->j', zty ) 737 488 ENDIF 738 frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid739 frcv(jpr_oty1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd component on the 2nd grid489 sf(jp_otx1)%fnow(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid 490 sf(jp_oty1)%fnow(:,:,1) = zty(:,:) ! overwrite 2nd component on the 2nd grid 740 491 ENDIF 741 492 ! 742 IF( s rcv(jpr_otx1)%clgrid == 'T' ) THEN493 IF( sf(jp_otx1)%clvgrd == 'T' ) THEN 743 494 DO jj = 2, jpjm1 ! T ==> (U,V) 744 495 DO ji = fs_2, fs_jpim1 ! vector opt. 745 frcv(jpr_otx1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_otx1)%z3(ji+1,jj ,1) + frcv(jpr_otx1)%z3(ji,jj,1) )746 frcv(jpr_oty1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_oty1)%z3(ji ,jj+1,1) + frcv(jpr_oty1)%z3(ji,jj,1) )747 END DO 748 END DO 749 CALL lbc_lnk( frcv(jpr_otx1)%z3(:,:,1), 'U', -1. ) ; CALL lbc_lnk( frcv(jpr_oty1)%z3(:,:,1), 'V', -1. )496 sf(jp_otx1)%fnow(ji,jj,1) = 0.5 * ( sf(jp_otx1)%fnow(ji+1,jj ,1) + sf(jp_otx1)%fnow(ji,jj,1) ) 497 sf(jp_oty1)%fnow(ji,jj,1) = 0.5 * ( sf(jp_oty1)%fnow(ji ,jj+1,1) + sf(jp_oty1)%fnow(ji,jj,1) ) 498 END DO 499 END DO 500 CALL lbc_lnk( sf(jp_otx1)%fnow(:,:,1), 'U', -1. ) ; CALL lbc_lnk( sf(jp_oty1)%fnow(:,:,1), 'V', -1. ) 750 501 ENDIF 751 502 llnewtx = .TRUE. … … 756 507 ELSE ! No dynamical coupling ! 757 508 ! ! ========================= ! 758 frcv(jpr_otx1)%z3(:,:,1) = 0.e0 ! here simply set to zero759 frcv(jpr_oty1)%z3(:,:,1) = 0.e0 ! an external read in a file can be added instead509 sf(jp_otx1)%fnow(:,:,1) = 0.e0 ! here simply set to zero 510 sf(jp_oty1)%fnow(:,:,1) = 0.e0 ! an external read in a file can be added instead 760 511 llnewtx = .TRUE. 761 512 ! … … 766 517 ! ! ========================= ! 767 518 ! 768 IF( .NOT. s rcv(jpr_taum)%laction) THEN ! compute wind stress module from its components if not received519 IF( .NOT. sf(jp_taum)%loasis ) THEN ! compute wind stress module from its components if not received 769 520 ! => need to be done only when otx1 was changed 770 521 IF( llnewtx ) THEN … … 773 524 !CDIR NOVERRCHK 774 525 DO ji = fs_2, fs_jpim1 ! vect. opt. 775 zzx = frcv(jpr_otx1)%z3(ji-1,jj ,1) + frcv(jpr_otx1)%z3(ji,jj,1)776 zzy = frcv(jpr_oty1)%z3(ji ,jj-1,1) + frcv(jpr_oty1)%z3(ji,jj,1)777 frcv(jpr_taum)%z3(ji,jj,1) = 0.5 * SQRT( zzx * zzx + zzy * zzy )526 zzx = sf(jp_otx1)%fnow(ji-1,jj ,1) + sf(jp_otx1)%fnow(ji,jj,1) 527 zzy = sf(jp_oty1)%fnow(ji ,jj-1,1) + sf(jp_oty1)%fnow(ji,jj,1) 528 sf(jp_taum)%fnow(ji,jj,1) = 0.5 * SQRT( zzx * zzx + zzy * zzy ) 778 529 END DO 779 530 END DO 780 CALL lbc_lnk( frcv(jpr_taum)%z3(:,:,1), 'T', 1. )531 CALL lbc_lnk( sf(jp_taum)%fnow(:,:,1), 'T', 1. ) 781 532 llnewtau = .TRUE. 782 533 ELSE … … 784 535 ENDIF 785 536 ELSE 786 llnewtau = nrcvinfo(jpr_taum)== OASIS_Rcv537 llnewtau = sf(jp_taum)%ninfo == OASIS_Rcv 787 538 ! Stress module can be negative when received (interpolation problem) 788 539 IF( llnewtau ) THEN 789 frcv(jpr_taum)%z3(:,:,1) = MAX( 0._wp, frcv(jpr_taum)%z3(:,:,1) )540 sf(jp_taum)%fnow(:,:,1) = MAX( 0._wp, sf(jp_taum)%fnow(:,:,1) ) 790 541 ENDIF 791 542 ENDIF … … 795 546 ! ! ========================= ! 796 547 ! 797 IF( .NOT. s rcv(jpr_w10m)%laction) THEN ! compute wind spreed from wind stress module if not received548 IF( .NOT. sf(jp_w10m)%loasis ) THEN ! compute wind spreed from wind stress module if not received 798 549 ! => need to be done only when taumod was changed 799 550 IF( llnewtau ) THEN … … 803 554 !CDIR NOVERRCHK 804 555 DO ji = 1, jpi 805 wndm(ji,jj) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef )556 wndm(ji,jj) = SQRT( sf(jp_taum)%fnow(ji,jj,1) * zcoef ) 806 557 END DO 807 558 END DO 808 559 ENDIF 809 560 ELSE 810 IF ( nrcvinfo(jpr_w10m) == OASIS_Rcv ) wndm(:,:) = frcv(jpr_w10m)%z3(:,:,1)561 IF ( sf(jp_w10m)%ninfo == OASIS_Rcv ) wndm(:,:) = sf(jp_w10m)%fnow(:,:,1) 811 562 ENDIF 812 563 … … 815 566 IF( MOD( kt-1, k_fsbc ) == 0 ) THEN 816 567 ! 817 utau(:,:) = frcv(jpr_otx1)%z3(:,:,1)818 vtau(:,:) = frcv(jpr_oty1)%z3(:,:,1)819 taum(:,:) = frcv(jpr_taum)%z3(:,:,1)568 utau(:,:) = sf(jp_otx1)%fnow(:,:,1) 569 vtau(:,:) = sf(jp_oty1)%fnow(:,:,1) 570 taum(:,:) = sf(jp_taum)%fnow(:,:,1) 820 571 CALL iom_put( "taum_oce", taum ) ! output wind stress module 821 572 ! … … 824 575 #if defined key_cpl_carbon_cycle 825 576 ! ! atmosph. CO2 (ppm) 826 IF( s rcv(jpr_co2)%laction ) atm_co2(:,:) = frcv(jpr_co2)%z3(:,:,1)577 IF( sf(jp_co2)%loasis ) atm_co2(:,:) = sf(jp_co2)%fnow(:,:,1) 827 578 #endif 828 579 … … 834 585 SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) ! evaporation - precipitation 835 586 CASE( 'conservative' ) 836 emp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ( frcv(jpr_rain)%z3(:,:,1) + frcv(jpr_snow)%z3(:,:,1) )587 emp(:,:) = sf(jp_tevp)%fnow(:,:,1) - ( sf(jp_rain)%fnow(:,:,1) + sf(jp_snow)%fnow(:,:,1) ) 837 588 CASE( 'oce only', 'oce and ice' ) 838 emp(:,:) = frcv(jpr_oemp)%z3(:,:,1)589 emp(:,:) = sf(jp_oemp)%fnow(:,:,1) 839 590 CASE default 840 591 CALL ctl_stop( 'sbc_cpl_rcv: wrong definition of sn_rcv_emp%cldes' ) … … 842 593 ! 843 594 ! ! runoffs and calving (added in emp) 844 IF( s rcv(jpr_rnf)%laction ) emp(:,:) = emp(:,:) - frcv(jpr_rnf)%z3(:,:,1)845 IF( s rcv(jpr_cal)%laction ) emp(:,:) = emp(:,:) - frcv(jpr_cal)%z3(:,:,1)595 IF( sf(jp_rnf)%loasis ) emp(:,:) = emp(:,:) - sf(jp_rnf)%fnow(:,:,1) 596 IF( sf(jp_cal)%loasis ) emp(:,:) = emp(:,:) - sf(jp_cal)%fnow(:,:,1) 846 597 ! 847 598 !!gm : this seems to be internal cooking, not sure to need that in a generic interface … … 849 600 !! IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) THEN ! add to the total freshwater budget 850 601 !! ! remove negative runoff 851 !! zcumulpos = SUM( MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )852 !! zcumulneg = SUM( MIN( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )602 !! zcumulpos = SUM( MAX( sf(jp_rnf)%fnow(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 603 !! zcumulneg = SUM( MIN( sf(jp_rnf)%fnow(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 853 604 !! IF( lk_mpp ) CALL mpp_sum( zcumulpos ) ! sum over the global domain 854 605 !! IF( lk_mpp ) CALL mpp_sum( zcumulneg ) 855 606 !! IF( zcumulpos /= 0. ) THEN ! distribute negative runoff on positive runoff grid points 856 607 !! zcumulneg = 1.e0 + zcumulneg / zcumulpos 857 !! frcv(jpr_rnf)%z3(:,:,1) = MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * zcumulneg608 !! sf(jp_rnf)%fnow(:,:,1) = MAX( sf(jp_rnf)%fnow(:,:,1), 0.e0 ) * zcumulneg 858 609 !! ENDIF 859 610 !! ! add runoff to e-p 860 !! emp(:,:) = emp(:,:) - frcv(jpr_rnf)%z3(:,:,1)611 !! emp(:,:) = emp(:,:) - sf(jp_rnf)%fnow(:,:,1) 861 612 !! ENDIF 862 613 !!gm end of internal cooking 863 614 ! 864 615 ! ! non solar heat flux over the ocean (qns) 865 IF( s rcv(jpr_qnsoce)%laction ) qns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1)866 IF( s rcv(jpr_qnsmix)%laction ) qns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1)616 IF( sf(jp_qnsoce)%loasis ) qns(:,:) = sf(jp_qnsoce)%fnow(:,:,1) 617 IF( sf(jp_qnsmix)%loasis ) qns(:,:) = sf(jp_qnsmix)%fnow(:,:,1) 867 618 ! add the latent heat of solid precip. melting 868 IF( s rcv(jpr_snow )%laction) THEN ! update qns over the free ocean with:869 qns(:,:) = qns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus & ! energy for melting solid precipitation over the free ocean619 IF( sf(jp_snow )%loasis ) THEN ! update qns over the free ocean with: 620 qns(:,:) = qns(:,:) - sf(jp_snow)%fnow(:,:,1) * lfus & ! energy for melting solid precipitation over the free ocean 870 621 & - emp(:,:) * sst_m(:,:) * rcp ! remove heat content due to mass flux (assumed to be at SST) 871 622 ENDIF 872 623 873 624 ! ! solar flux over the ocean (qsr) 874 IF( s rcv(jpr_qsroce)%laction ) qsr(:,:) = frcv(jpr_qsroce)%z3(:,:,1)875 IF( s rcv(jpr_qsrmix)%laction ) qsr(:,:) = frcv(jpr_qsrmix)%z3(:,:,1)625 IF( sf(jp_qsroce)%loasis ) qsr(:,:) = sf(jp_qsroce)%fnow(:,:,1) 626 IF( sf(jp_qsrmix)%loasis ) qsr(:,:) = sf(jp_qsrmix)%fnow(:,:,1) 876 627 IF( ln_dm2dc ) qsr(:,:) = sbc_dcy( qsr ) ! modify qsr to include the diurnal cycle 877 628 ! … … 931 682 CALL wrk_alloc( jpi,jpj, ztx, zty ) 932 683 933 IF( s rcv(jpr_itx1)%laction ) THEN ; itx = jpr_itx1934 ELSE ; itx = jp r_otx1684 IF( sf(jp_itx1)%loasis ) THEN ; itx = jp_itx1 685 ELSE ; itx = jp_otx1 935 686 ENDIF 936 687 937 688 ! do something only if we just received the stress from atmosphere 938 IF( nrcvinfo(itx)== OASIS_Rcv ) THEN689 IF( sf(itx)%ninfo == OASIS_Rcv ) THEN 939 690 940 691 ! ! ======================= ! 941 IF( s rcv(jpr_itx1)%laction) THEN ! ice stress received !692 IF( sf(jp_itx1)%loasis ) THEN ! ice stress received ! 942 693 ! ! ======================= ! 943 694 ! 944 695 IF( TRIM( sn_rcv_tau%clvref ) == 'cartesian' ) THEN ! 2 components on the sphere 945 696 ! ! (cartesian to spherical -> 3 to 2 components) 946 CALL geo2oce( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), frcv(jpr_itz1)%z3(:,:,1), &947 & s rcv(jpr_itx1)%clgrid, ztx, zty )948 frcv(jpr_itx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st comp. on the 1st grid949 frcv(jpr_ity1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd comp. on the 1st grid697 CALL geo2oce( sf(jp_itx1)%fnow(:,:,1), sf(jp_ity1)%fnow(:,:,1), sf(jp_itz1)%fnow(:,:,1), & 698 & sf(jp_itx1)%clvgrd, ztx, zty ) 699 sf(jp_itx1)%fnow(:,:,1) = ztx(:,:) ! overwrite 1st comp. on the 1st grid 700 sf(jp_ity1)%fnow(:,:,1) = zty(:,:) ! overwrite 2nd comp. on the 1st grid 950 701 ! 951 IF( s rcv(jpr_itx2)%laction) THEN952 CALL geo2oce( frcv(jpr_itx2)%z3(:,:,1), frcv(jpr_ity2)%z3(:,:,1), frcv(jpr_itz2)%z3(:,:,1), &953 & s rcv(jpr_itx2)%clgrid, ztx, zty )954 frcv(jpr_itx2)%z3(:,:,1) = ztx(:,:) ! overwrite 1st comp. on the 2nd grid955 frcv(jpr_ity2)%z3(:,:,1) = zty(:,:) ! overwrite 2nd comp. on the 2nd grid702 IF( sf(jp_itx2)%loasis ) THEN 703 CALL geo2oce( sf(jp_itx2)%fnow(:,:,1), sf(jp_ity2)%fnow(:,:,1), sf(jp_itz2)%fnow(:,:,1), & 704 & sf(jp_itx2)%clvgrd, ztx, zty ) 705 sf(jp_itx2)%fnow(:,:,1) = ztx(:,:) ! overwrite 1st comp. on the 2nd grid 706 sf(jp_ity2)%fnow(:,:,1) = zty(:,:) ! overwrite 2nd comp. on the 2nd grid 956 707 ENDIF 957 708 ! … … 960 711 IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN ! 2 components oriented along the local grid 961 712 ! ! (geographical to local grid -> rotate the components) 962 CALL rot_rep( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), srcv(jpr_itx1)%clgrid, 'en->i', ztx )963 IF( s rcv(jpr_itx2)%laction) THEN964 CALL rot_rep( frcv(jpr_itx2)%z3(:,:,1), frcv(jpr_ity2)%z3(:,:,1), srcv(jpr_itx2)%clgrid, 'en->j', zty )713 CALL rot_rep( sf(jp_itx1)%fnow(:,:,1), sf(jp_ity1)%fnow(:,:,1), sf(jp_itx1)%clvgrd, 'en->i', ztx ) 714 IF( sf(jp_itx2)%loasis ) THEN 715 CALL rot_rep( sf(jp_itx2)%fnow(:,:,1), sf(jp_ity2)%fnow(:,:,1), sf(jp_itx2)%clvgrd, 'en->j', zty ) 965 716 ELSE 966 CALL rot_rep( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), srcv(jpr_itx1)%clgrid, 'en->j', zty )717 CALL rot_rep( sf(jp_itx1)%fnow(:,:,1), sf(jp_ity1)%fnow(:,:,1), sf(jp_itx1)%clvgrd, 'en->j', zty ) 967 718 ENDIF 968 frcv(jpr_itx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid969 frcv(jpr_ity1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd component on the 1st grid719 sf(jp_itx1)%fnow(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid 720 sf(jp_ity1)%fnow(:,:,1) = zty(:,:) ! overwrite 2nd component on the 1st grid 970 721 ENDIF 971 722 ! ! ======================= ! 972 723 ELSE ! use ocean stress ! 973 724 ! ! ======================= ! 974 frcv(jpr_itx1)%z3(:,:,1) = frcv(jpr_otx1)%z3(:,:,1)975 frcv(jpr_ity1)%z3(:,:,1) = frcv(jpr_oty1)%z3(:,:,1)725 sf(jp_itx1)%fnow(:,:,1) = sf(jp_otx1)%fnow(:,:,1) 726 sf(jp_ity1)%fnow(:,:,1) = sf(jp_oty1)%fnow(:,:,1) 976 727 ! 977 728 ENDIF … … 992 743 ! 993 744 CASE( 'I' ) ! B-grid ==> I 994 SELECT CASE ( s rcv(jpr_itx1)%clgrid )745 SELECT CASE ( sf(jp_itx1)%clvgrd ) 995 746 CASE( 'U' ) 996 747 DO jj = 2, jpjm1 ! (U,V) ==> I 997 748 DO ji = 2, jpim1 ! NO vector opt. 998 p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji-1,jj ,1) + frcv(jpr_itx1)%z3(ji-1,jj-1,1) )999 p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji ,jj-1,1) + frcv(jpr_ity1)%z3(ji-1,jj-1,1) )749 p_taui(ji,jj) = 0.5 * ( sf(jp_itx1)%fnow(ji-1,jj ,1) + sf(jp_itx1)%fnow(ji-1,jj-1,1) ) 750 p_tauj(ji,jj) = 0.5 * ( sf(jp_ity1)%fnow(ji ,jj-1,1) + sf(jp_ity1)%fnow(ji-1,jj-1,1) ) 1000 751 END DO 1001 752 END DO … … 1003 754 DO jj = 2, jpjm1 ! F ==> I 1004 755 DO ji = 2, jpim1 ! NO vector opt. 1005 p_taui(ji,jj) = frcv(jpr_itx1)%z3(ji-1,jj-1,1)1006 p_tauj(ji,jj) = frcv(jpr_ity1)%z3(ji-1,jj-1,1)756 p_taui(ji,jj) = sf(jp_itx1)%fnow(ji-1,jj-1,1) 757 p_tauj(ji,jj) = sf(jp_ity1)%fnow(ji-1,jj-1,1) 1007 758 END DO 1008 759 END DO … … 1010 761 DO jj = 2, jpjm1 ! T ==> I 1011 762 DO ji = 2, jpim1 ! NO vector opt. 1012 p_taui(ji,jj) = 0.25 * ( frcv(jpr_itx1)%z3(ji,jj ,1) + frcv(jpr_itx1)%z3(ji-1,jj ,1) &1013 & + frcv(jpr_itx1)%z3(ji,jj-1,1) + frcv(jpr_itx1)%z3(ji-1,jj-1,1) )1014 p_tauj(ji,jj) = 0.25 * ( frcv(jpr_ity1)%z3(ji,jj ,1) + frcv(jpr_ity1)%z3(ji-1,jj ,1) &1015 & + frcv(jpr_oty1)%z3(ji,jj-1,1) + frcv(jpr_ity1)%z3(ji-1,jj-1,1) )763 p_taui(ji,jj) = 0.25 * ( sf(jp_itx1)%fnow(ji,jj ,1) + sf(jp_itx1)%fnow(ji-1,jj ,1) & 764 & + sf(jp_itx1)%fnow(ji,jj-1,1) + sf(jp_itx1)%fnow(ji-1,jj-1,1) ) 765 p_tauj(ji,jj) = 0.25 * ( sf(jp_ity1)%fnow(ji,jj ,1) + sf(jp_ity1)%fnow(ji-1,jj ,1) & 766 & + sf(jp_oty1)%fnow(ji,jj-1,1) + sf(jp_ity1)%fnow(ji-1,jj-1,1) ) 1016 767 END DO 1017 768 END DO 1018 769 CASE( 'I' ) 1019 p_taui(:,:) = frcv(jpr_itx1)%z3(:,:,1) ! I ==> I1020 p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1)770 p_taui(:,:) = sf(jp_itx1)%fnow(:,:,1) ! I ==> I 771 p_tauj(:,:) = sf(jp_ity1)%fnow(:,:,1) 1021 772 END SELECT 1022 IF( s rcv(jpr_itx1)%clgrid /= 'I' ) THEN773 IF( sf(jp_itx1)%clvgrd /= 'I' ) THEN 1023 774 CALL lbc_lnk( p_taui, 'I', -1. ) ; CALL lbc_lnk( p_tauj, 'I', -1. ) 1024 775 ENDIF 1025 776 ! 1026 777 CASE( 'F' ) ! B-grid ==> F 1027 SELECT CASE ( s rcv(jpr_itx1)%clgrid )778 SELECT CASE ( sf(jp_itx1)%clvgrd ) 1028 779 CASE( 'U' ) 1029 780 DO jj = 2, jpjm1 ! (U,V) ==> F 1030 781 DO ji = fs_2, fs_jpim1 ! vector opt. 1031 p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji,jj,1) + frcv(jpr_itx1)%z3(ji ,jj+1,1) )1032 p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji,jj,1) + frcv(jpr_ity1)%z3(ji+1,jj ,1) )782 p_taui(ji,jj) = 0.5 * ( sf(jp_itx1)%fnow(ji,jj,1) + sf(jp_itx1)%fnow(ji ,jj+1,1) ) 783 p_tauj(ji,jj) = 0.5 * ( sf(jp_ity1)%fnow(ji,jj,1) + sf(jp_ity1)%fnow(ji+1,jj ,1) ) 1033 784 END DO 1034 785 END DO … … 1036 787 DO jj = 2, jpjm1 ! I ==> F 1037 788 DO ji = 2, jpim1 ! NO vector opt. 1038 p_taui(ji,jj) = frcv(jpr_itx1)%z3(ji+1,jj+1,1)1039 p_tauj(ji,jj) = frcv(jpr_ity1)%z3(ji+1,jj+1,1)789 p_taui(ji,jj) = sf(jp_itx1)%fnow(ji+1,jj+1,1) 790 p_tauj(ji,jj) = sf(jp_ity1)%fnow(ji+1,jj+1,1) 1040 791 END DO 1041 792 END DO … … 1043 794 DO jj = 2, jpjm1 ! T ==> F 1044 795 DO ji = 2, jpim1 ! NO vector opt. 1045 p_taui(ji,jj) = 0.25 * ( frcv(jpr_itx1)%z3(ji,jj ,1) + frcv(jpr_itx1)%z3(ji+1,jj ,1) &1046 & + frcv(jpr_itx1)%z3(ji,jj+1,1) + frcv(jpr_itx1)%z3(ji+1,jj+1,1) )1047 p_tauj(ji,jj) = 0.25 * ( frcv(jpr_ity1)%z3(ji,jj ,1) + frcv(jpr_ity1)%z3(ji+1,jj ,1) &1048 & + frcv(jpr_ity1)%z3(ji,jj+1,1) + frcv(jpr_ity1)%z3(ji+1,jj+1,1) )796 p_taui(ji,jj) = 0.25 * ( sf(jp_itx1)%fnow(ji,jj ,1) + sf(jp_itx1)%fnow(ji+1,jj ,1) & 797 & + sf(jp_itx1)%fnow(ji,jj+1,1) + sf(jp_itx1)%fnow(ji+1,jj+1,1) ) 798 p_tauj(ji,jj) = 0.25 * ( sf(jp_ity1)%fnow(ji,jj ,1) + sf(jp_ity1)%fnow(ji+1,jj ,1) & 799 & + sf(jp_ity1)%fnow(ji,jj+1,1) + sf(jp_ity1)%fnow(ji+1,jj+1,1) ) 1049 800 END DO 1050 801 END DO 1051 802 CASE( 'F' ) 1052 p_taui(:,:) = frcv(jpr_itx1)%z3(:,:,1) ! F ==> F1053 p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1)803 p_taui(:,:) = sf(jp_itx1)%fnow(:,:,1) ! F ==> F 804 p_tauj(:,:) = sf(jp_ity1)%fnow(:,:,1) 1054 805 END SELECT 1055 IF( s rcv(jpr_itx1)%clgrid /= 'F' ) THEN806 IF( sf(jp_itx1)%clvgrd /= 'F' ) THEN 1056 807 CALL lbc_lnk( p_taui, 'F', -1. ) ; CALL lbc_lnk( p_tauj, 'F', -1. ) 1057 808 ENDIF 1058 809 ! 1059 810 CASE( 'C' ) ! C-grid ==> U,V 1060 SELECT CASE ( s rcv(jpr_itx1)%clgrid )811 SELECT CASE ( sf(jp_itx1)%clvgrd ) 1061 812 CASE( 'U' ) 1062 p_taui(:,:) = frcv(jpr_itx1)%z3(:,:,1) ! (U,V) ==> (U,V)1063 p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1)813 p_taui(:,:) = sf(jp_itx1)%fnow(:,:,1) ! (U,V) ==> (U,V) 814 p_tauj(:,:) = sf(jp_ity1)%fnow(:,:,1) 1064 815 CASE( 'F' ) 1065 816 DO jj = 2, jpjm1 ! F ==> (U,V) 1066 817 DO ji = fs_2, fs_jpim1 ! vector opt. 1067 p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji,jj,1) + frcv(jpr_itx1)%z3(ji ,jj-1,1) )1068 p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(jj,jj,1) + frcv(jpr_ity1)%z3(ji-1,jj ,1) )818 p_taui(ji,jj) = 0.5 * ( sf(jp_itx1)%fnow(ji,jj,1) + sf(jp_itx1)%fnow(ji ,jj-1,1) ) 819 p_tauj(ji,jj) = 0.5 * ( sf(jp_ity1)%fnow(jj,jj,1) + sf(jp_ity1)%fnow(ji-1,jj ,1) ) 1069 820 END DO 1070 821 END DO … … 1072 823 DO jj = 2, jpjm1 ! T ==> (U,V) 1073 824 DO ji = fs_2, fs_jpim1 ! vector opt. 1074 p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji+1,jj ,1) + frcv(jpr_itx1)%z3(ji,jj,1) )1075 p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji ,jj+1,1) + frcv(jpr_ity1)%z3(ji,jj,1) )825 p_taui(ji,jj) = 0.5 * ( sf(jp_itx1)%fnow(ji+1,jj ,1) + sf(jp_itx1)%fnow(ji,jj,1) ) 826 p_tauj(ji,jj) = 0.5 * ( sf(jp_ity1)%fnow(ji ,jj+1,1) + sf(jp_ity1)%fnow(ji,jj,1) ) 1076 827 END DO 1077 828 END DO … … 1079 830 DO jj = 2, jpjm1 ! I ==> (U,V) 1080 831 DO ji = 2, jpim1 ! NO vector opt. 1081 p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji+1,jj+1,1) + frcv(jpr_itx1)%z3(ji+1,jj ,1) )1082 p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji+1,jj+1,1) + frcv(jpr_ity1)%z3(ji ,jj+1,1) )832 p_taui(ji,jj) = 0.5 * ( sf(jp_itx1)%fnow(ji+1,jj+1,1) + sf(jp_itx1)%fnow(ji+1,jj ,1) ) 833 p_tauj(ji,jj) = 0.5 * ( sf(jp_ity1)%fnow(ji+1,jj+1,1) + sf(jp_ity1)%fnow(ji ,jj+1,1) ) 1083 834 END DO 1084 835 END DO 1085 836 END SELECT 1086 IF( s rcv(jpr_itx1)%clgrid /= 'U' ) THEN837 IF( sf(jp_itx1)%clvgrd /= 'U' ) THEN 1087 838 CALL lbc_lnk( p_taui, 'U', -1. ) ; CALL lbc_lnk( p_tauj, 'V', -1. ) 1088 839 ENDIF … … 1163 914 ! ! solid Precipitation (sprecip) 1164 915 SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) 1165 CASE( 'conservative' ) ! received fields: jp r_rain, jpr_snow, jpr_ievp, jpr_tevp1166 sprecip(:,:) = frcv(jpr_snow)%z3(:,:,1) ! May need to ensure positive here1167 tprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + sprecip (:,:) ! May need to ensure positive here1168 emp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - tprecip(:,:)1169 emp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1)1170 CALL iom_put( 'rain' , frcv(jpr_rain)%z3(:,:,1) ) ! liquid precipitation1171 IF( lk_diaar5 ) CALL iom_put( 'hflx_rain_cea', frcv(jpr_rain)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from liq. precip.1172 ztmp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:)916 CASE( 'conservative' ) ! received fields: jp_rain, jp_snow, jp_ievp, jp_tevp 917 sprecip(:,:) = sf(jp_snow)%fnow(:,:,1) ! May need to ensure positive here 918 tprecip(:,:) = sf(jp_rain)%fnow(:,:,1) + sprecip (:,:) ! May need to ensure positive here 919 emp_tot(:,:) = sf(jp_tevp)%fnow(:,:,1) - tprecip(:,:) 920 emp_ice(:,:) = sf(jp_ievp)%fnow(:,:,1) - sf(jp_snow)%fnow(:,:,1) 921 CALL iom_put( 'rain' , sf(jp_rain)%fnow(:,:,1) ) ! liquid precipitation 922 IF( lk_diaar5 ) CALL iom_put( 'hflx_rain_cea', sf(jp_rain)%fnow(:,:,1) * zcptn(:,:) ) ! heat flux from liq. precip. 923 ztmp(:,:) = sf(jp_tevp)%fnow(:,:,1) - sf(jp_ievp)%fnow(:,:,1) * zicefr(:,:) 1173 924 CALL iom_put( 'evap_ao_cea' , ztmp ) ! ice-free oce evap (cell average) 1174 925 IF( lk_diaar5 ) CALL iom_put( 'hflx_evap_cea', ztmp(:,: ) * zcptn(:,:) ) ! heat flux from from evap (cell ave) 1175 CASE( 'oce and ice' ) ! received fields: jp r_sbpr, jpr_semp, jpr_oemp, jpr_ievp1176 emp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1)1177 emp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1)1178 sprecip(:,:) = - frcv(jpr_semp)%z3(:,:,1) + frcv(jpr_ievp)%z3(:,:,1)926 CASE( 'oce and ice' ) ! received fields: jp_sbpr, jp_semp, jp_oemp, jp_ievp 927 emp_tot(:,:) = p_frld(:,:) * sf(jp_oemp)%fnow(:,:,1) + zicefr(:,:) * sf(jp_sbpr)%fnow(:,:,1) 928 emp_ice(:,:) = sf(jp_semp)%fnow(:,:,1) 929 sprecip(:,:) = - sf(jp_semp)%fnow(:,:,1) + sf(jp_ievp)%fnow(:,:,1) 1179 930 END SELECT 1180 931 … … 1182 933 CALL iom_put( 'snow_ao_cea', sprecip(:,: ) * p_frld(:,:) ) ! Snow over ice-free ocean (cell average) 1183 934 CALL iom_put( 'snow_ai_cea', sprecip(:,: ) * zicefr(:,:) ) ! Snow over sea-ice (cell average) 1184 CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) ! Sublimation over sea-ice (cell average)935 CALL iom_put( 'subl_ai_cea', sf(jp_ievp)%fnow(:,:,1) * zicefr(:,:) ) ! Sublimation over sea-ice (cell average) 1185 936 ! 1186 937 ! ! runoffs and calving (put in emp_tot) 1187 IF( s rcv(jpr_rnf)%laction) THEN1188 emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_rnf)%z3(:,:,1)1189 CALL iom_put( 'runoffs' , frcv(jpr_rnf)%z3(:,:,1) ) ! rivers1190 IF( lk_diaar5 ) CALL iom_put( 'hflx_rnf_cea' , frcv(jpr_rnf)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from rivers1191 ENDIF 1192 IF( s rcv(jpr_cal)%laction) THEN1193 emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1)1194 CALL iom_put( 'calving', frcv(jpr_cal)%z3(:,:,1) )938 IF( sf(jp_rnf)%loasis ) THEN 939 emp_tot(:,:) = emp_tot(:,:) - sf(jp_rnf)%fnow(:,:,1) 940 CALL iom_put( 'runoffs' , sf(jp_rnf)%fnow(:,:,1) ) ! rivers 941 IF( lk_diaar5 ) CALL iom_put( 'hflx_rnf_cea' , sf(jp_rnf)%fnow(:,:,1) * zcptn(:,:) ) ! heat flux from rivers 942 ENDIF 943 IF( sf(jp_cal)%loasis ) THEN 944 emp_tot(:,:) = emp_tot(:,:) - sf(jp_cal)%fnow(:,:,1) 945 CALL iom_put( 'calving', sf(jp_cal)%fnow(:,:,1) ) 1195 946 ENDIF 1196 947 ! … … 1198 949 !!gm at least should be optional... 1199 950 !! ! remove negative runoff ! sum over the global domain 1200 !! zcumulpos = SUM( MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )1201 !! zcumulneg = SUM( MIN( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )951 !! zcumulpos = SUM( MAX( sf(jp_rnf)%fnow(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 952 !! zcumulneg = SUM( MIN( sf(jp_rnf)%fnow(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 1202 953 !! IF( lk_mpp ) CALL mpp_sum( zcumulpos ) 1203 954 !! IF( lk_mpp ) CALL mpp_sum( zcumulneg ) 1204 955 !! IF( zcumulpos /= 0. ) THEN ! distribute negative runoff on positive runoff grid points 1205 956 !! zcumulneg = 1.e0 + zcumulneg / zcumulpos 1206 !! frcv(jpr_rnf)%z3(:,:,1) = MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * zcumulneg957 !! sf(jp_rnf)%fnow(:,:,1) = MAX( sf(jp_rnf)%fnow(:,:,1), 0.e0 ) * zcumulneg 1207 958 !! ENDIF 1208 !! emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_rnf)%z3(:,:,1) ! add runoff to e-p959 !! emp_tot(:,:) = emp_tot(:,:) - sf(jp_rnf)%fnow(:,:,1) ! add runoff to e-p 1209 960 !! 1210 961 !!gm end of internal cooking … … 1214 965 ! ! ========================= ! 1215 966 CASE( 'oce only' ) ! the required field is directly provided 1216 qns_tot(:,: ) = frcv(jpr_qnsoce)%z3(:,:,1)967 qns_tot(:,: ) = sf(jp_qnsoce)%fnow(:,:,1) 1217 968 CASE( 'conservative' ) ! the required fields are directly provided 1218 qns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1)969 qns_tot(:,: ) = sf(jp_qnsmix)%fnow(:,:,1) 1219 970 IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 1220 qns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl)971 qns_ice(:,:,1:jpl) = sf(jp_qnsice)%fnow(:,:,1:jpl) 1221 972 ELSE 1222 973 ! Set all category values equal for the moment 1223 974 DO jl=1,jpl 1224 qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1)975 qns_ice(:,:,jl) = sf(jp_qnsice)%fnow(:,:,1) 1225 976 ENDDO 1226 977 ENDIF 1227 978 CASE( 'oce and ice' ) ! the total flux is computed from ocean and ice fluxes 1228 qns_tot(:,: ) = p_frld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1)979 qns_tot(:,: ) = p_frld(:,:) * sf(jp_qnsoce)%fnow(:,:,1) 1229 980 IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 1230 981 DO jl=1,jpl 1231 qns_tot(:,: ) = qns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl)1232 qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,jl)982 qns_tot(:,: ) = qns_tot(:,:) + a_i(:,:,jl) * sf(jp_qnsice)%fnow(:,:,jl) 983 qns_ice(:,:,jl) = sf(jp_qnsice)%fnow(:,:,jl) 1233 984 ENDDO 1234 985 ELSE 1235 986 DO jl=1,jpl 1236 qns_tot(:,: ) = qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1)1237 qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1)987 qns_tot(:,: ) = qns_tot(:,:) + zicefr(:,:) * sf(jp_qnsice)%fnow(:,:,1) 988 qns_ice(:,:,jl) = sf(jp_qnsice)%fnow(:,:,1) 1238 989 ENDDO 1239 990 ENDIF 1240 991 CASE( 'mixed oce-ice' ) ! the ice flux is cumputed from the total flux, the SST and ice informations 1241 992 ! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED ** 1242 qns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1)1243 qns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1) &1244 & + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,: ) ) * p_frld(:,:) &993 qns_tot(:,: ) = sf(jp_qnsmix)%fnow(:,:,1) 994 qns_ice(:,:,1) = sf(jp_qnsmix)%fnow(:,:,1) & 995 & + sf(jp_dqnsdt)%fnow(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,: ) ) * p_frld(:,:) & 1245 996 & + pist(:,:,1) * zicefr(:,:) ) ) 1246 997 END SELECT … … 1259 1010 !! similar job should be done for snow and precipitation temperature 1260 1011 ! 1261 IF( s rcv(jpr_cal)%laction) THEN ! Iceberg melting1262 ztmp(:,:) = frcv(jpr_cal)%z3(:,:,1) * lfus ! add the latent heat of iceberg melting1012 IF( sf(jp_cal)%loasis ) THEN ! Iceberg melting 1013 ztmp(:,:) = sf(jp_cal)%fnow(:,:,1) * lfus ! add the latent heat of iceberg melting 1263 1014 qns_tot(:,:) = qns_tot(:,:) - ztmp(:,:) 1264 IF( lk_diaar5 ) CALL iom_put( 'hflx_cal_cea', ztmp + frcv(jpr_cal)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from calving1015 IF( lk_diaar5 ) CALL iom_put( 'hflx_cal_cea', ztmp + sf(jp_cal)%fnow(:,:,1) * zcptn(:,:) ) ! heat flux from calving 1265 1016 ENDIF 1266 1017 … … 1269 1020 ! ! ========================= ! 1270 1021 CASE( 'oce only' ) 1271 qsr_tot(:,: ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) )1022 qsr_tot(:,: ) = MAX( 0._wp , sf(jp_qsroce)%fnow(:,:,1) ) 1272 1023 CASE( 'conservative' ) 1273 qsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1)1024 qsr_tot(:,: ) = sf(jp_qsrmix)%fnow(:,:,1) 1274 1025 IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 1275 qsr_ice(:,:,1:jpl) = frcv(jpr_qsrice)%z3(:,:,1:jpl)1026 qsr_ice(:,:,1:jpl) = sf(jp_qsrice)%fnow(:,:,1:jpl) 1276 1027 ELSE 1277 1028 ! Set all category values equal for the moment 1278 1029 DO jl=1,jpl 1279 qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1)1030 qsr_ice(:,:,jl) = sf(jp_qsrice)%fnow(:,:,1) 1280 1031 ENDDO 1281 1032 ENDIF 1282 qsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1)1283 qsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1)1033 qsr_tot(:,: ) = sf(jp_qsrmix)%fnow(:,:,1) 1034 qsr_ice(:,:,1) = sf(jp_qsrice)%fnow(:,:,1) 1284 1035 CASE( 'oce and ice' ) 1285 qsr_tot(:,: ) = p_frld(:,:) * frcv(jpr_qsroce)%z3(:,:,1)1036 qsr_tot(:,: ) = p_frld(:,:) * sf(jp_qsroce)%fnow(:,:,1) 1286 1037 IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 1287 1038 DO jl=1,jpl 1288 qsr_tot(:,: ) = qsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl)1289 qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,jl)1039 qsr_tot(:,: ) = qsr_tot(:,:) + a_i(:,:,jl) * sf(jp_qsrice)%fnow(:,:,jl) 1040 qsr_ice(:,:,jl) = sf(jp_qsrice)%fnow(:,:,jl) 1290 1041 ENDDO 1291 1042 ELSE 1292 1043 DO jl=1,jpl 1293 qsr_tot(:,: ) = qsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1)1294 qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1)1044 qsr_tot(:,: ) = qsr_tot(:,:) + zicefr(:,:) * sf(jp_qsrice)%fnow(:,:,1) 1045 qsr_ice(:,:,jl) = sf(jp_qsrice)%fnow(:,:,1) 1295 1046 ENDDO 1296 1047 ENDIF 1297 1048 CASE( 'mixed oce-ice' ) 1298 qsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1)1049 qsr_tot(:,: ) = sf(jp_qsrmix)%fnow(:,:,1) 1299 1050 ! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED ** 1300 1051 ! Create solar heat flux over ice using incoming solar heat flux and albedos 1301 1052 ! ( see OASIS3 user guide, 5th edition, p39 ) 1302 qsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) ) &1053 qsr_ice(:,:,1) = sf(jp_qsrmix)%fnow(:,:,1) * ( 1.- palbi(:,:,1) ) & 1303 1054 & / ( 1.- ( albedo_oce_mix(:,: ) * p_frld(:,:) & 1304 1055 & + palbi (:,:,1) * zicefr(:,:) ) ) … … 1314 1065 CASE ('coupled') 1315 1066 IF ( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN 1316 dqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl)1067 dqns_ice(:,:,1:jpl) = sf(jp_dqnsdt)%fnow(:,:,1:jpl) 1317 1068 ELSE 1318 1069 ! Set all category values equal for the moment 1319 1070 DO jl=1,jpl 1320 dqns_ice(:,:,jl) = frcv(jpr_dqnsdt)%z3(:,:,1)1071 dqns_ice(:,:,jl) = sf(jp_dqnsdt)%fnow(:,:,1) 1321 1072 ENDDO 1322 1073 ENDIF … … 1325 1076 SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) ) 1326 1077 CASE ('coupled') 1327 topmelt(:,:,:)= frcv(jpr_topm)%z3(:,:,:)1328 botmelt(:,:,:)= frcv(jpr_botm)%z3(:,:,:)1078 topmelt(:,:,:)=sf(jp_topm)%fnow(:,:,:) 1079 botmelt(:,:,:)=sf(jp_botm)%fnow(:,:,:) 1329 1080 END SELECT 1330 1081 -
branches/UKMO/dev_3841_sbc/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90
r3625 r4827 17 17 USE sbcdcy ! surface boundary condition: diurnal cycle on qsr 18 18 USE phycst ! physical constants 19 USE fldread ! read input fields 19 USE fldread2 ! read input fields 20 USE fld_def 21 USE sbcget 20 22 USE iom ! IOM library 21 23 USE in_out_manager ! I/O manager … … 27 29 28 30 PUBLIC sbc_flx ! routine called by step.F90 29 30 INTEGER , PARAMETER :: jpfld = 5 ! maximum number of files to read31 INTEGER , PARAMETER :: jp_utau = 1 ! index of wind stress (i-component) file32 INTEGER , PARAMETER :: jp_vtau = 2 ! index of wind stress (j-component) file33 INTEGER , PARAMETER :: jp_qtot = 3 ! index of total (non solar+solar) heat file34 INTEGER , PARAMETER :: jp_qsr = 4 ! index of solar heat file35 INTEGER , PARAMETER :: jp_emp = 5 ! index of evaporation-precipation file36 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf ! structure of input fields (file informations, fields read)37 31 38 32 !! * Substitutions … … 76 70 !! 77 71 INTEGER :: ji, jj, jf ! dummy indices 78 INTEGER :: ierror ! return error code79 72 REAL(wp) :: zfact ! temporary scalar 80 73 REAL(wp) :: zrhoa = 1.22 ! Air density kg/m3 … … 82 75 REAL(wp) :: ztx, zty, zmod, zcoef ! temporary variables 83 76 !! 84 CHARACTER(len=100) :: cn_dir ! Root directory for location of flx files 85 TYPE(FLD_N), DIMENSION(jpfld) :: slf_i ! array of namelist information structures 86 TYPE(FLD_N) :: sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp ! informations about the fields to be read 87 NAMELIST/namsbc_flx/ cn_dir, sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp 77 ! CHARACTER(len=100) :: cn_dir ! Root directory for location of flx files 78 ! NAMELIST/namsbc_flx/ cn_dir, sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp 88 79 !!--------------------------------------------------------------------- 89 80 ! 90 81 IF( kt == nit000 ) THEN ! First call kt=nit000 91 ! set file information92 cn_dir = './' ! directory in which the model is executed93 ! ... default values (NB: frequency positive => hours, negative => months)94 ! ! file ! frequency ! variable ! time intep ! clim ! 'yearly' or ! weights ! rotation !95 ! ! name ! (hours) ! name ! (T/F) ! (T/F) ! 'monthly' ! filename ! pairs !96 sn_utau = FLD_N( 'utau' , 24 , 'utau' , .false. , .false. , 'yearly' , '' , '' )97 sn_vtau = FLD_N( 'vtau' , 24 , 'vtau' , .false. , .false. , 'yearly' , '' , '' )98 sn_qtot = FLD_N( 'qtot' , 24 , 'qtot' , .false. , .false. , 'yearly' , '' , '' )99 sn_qsr = FLD_N( 'qsr' , 24 , 'qsr' , .false. , .false. , 'yearly' , '' , '' )100 sn_emp = FLD_N( 'emp' , 24 , 'emp' , .false. , .false. , 'yearly' , '' , '' )101 !102 REWIND ( numnam ) ! read in namlist namflx103 READ ( numnam, namsbc_flx )104 82 ! 105 83 ! ! check: do we plan to use ln_dm2dc with non-daily forcing? 106 IF( ln_dm2dc .AND. s n_qsr%nfreqh /= 24 ) &84 IF( ln_dm2dc .AND. sf(jp_qsroce)%nfreqh /= 24 ) & 107 85 & CALL ctl_stop( 'sbc_blk_core: ln_dm2dc can be activated only with daily short-wave forcing' ) 108 !109 ! ! store namelist information in an array110 slf_i(jp_utau) = sn_utau ; slf_i(jp_vtau) = sn_vtau111 slf_i(jp_qtot) = sn_qtot ; slf_i(jp_qsr ) = sn_qsr112 slf_i(jp_emp ) = sn_emp113 !114 ALLOCATE( sf(jpfld), STAT=ierror ) ! set sf structure115 IF( ierror > 0 ) THEN116 CALL ctl_stop( 'sbc_flx: unable to allocate sf structure' ) ; RETURN117 ENDIF118 DO ji= 1, jpfld119 ALLOCATE( sf(ji)%fnow(jpi,jpj,1) )120 IF( slf_i(ji)%ln_tint ) ALLOCATE( sf(ji)%fdta(jpi,jpj,1,2) )121 END DO122 ! ! fill sf with slf_i and control print123 CALL fld_fill( sf, slf_i, cn_dir, 'sbc_flx', 'flux formulation for ocean surface boundary condition', 'namsbc_flx' )124 86 ! 125 87 sfx(:,:) = 0.0_wp ! salt flux due to freezing/melting (non-zero only if ice is present; set in limsbc(_2).F90) … … 127 89 ENDIF 128 90 129 CALL fld_read( kt, nn_fsbc, sf ) ! input fields provided at the current time-step130 131 91 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN ! update ocean fluxes at each SBC frequency 132 92 133 IF( ln_dm2dc ) THEN ; qsr(:,:) = sbc_dcy( sf(jp_qsr )%fnow(:,:,1) ) ! modify now Qsr to include the diurnal cycle134 ELSE ; qsr(:,:) = sf(jp_qsr )%fnow(:,:,1)93 IF( ln_dm2dc ) THEN ; qsr(:,:) = sbc_dcy( sf(jp_qsroce)%fnow(:,:,1) ) ! modify now Qsr to include the diurnal cycle 94 ELSE ; qsr(:,:) = sf(jp_qsroce)%fnow(:,:,1) 135 95 ENDIF 136 96 !CDIR COLLAPSE 137 97 DO jj = 1, jpj ! set the ocean fluxes from read fields 138 98 DO ji = 1, jpi 139 utau(ji,jj) = sf(jp_ utau)%fnow(ji,jj,1)140 vtau(ji,jj) = sf(jp_ vtau)%fnow(ji,jj,1)141 qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj,1) - sf(jp_qsr )%fnow(ji,jj,1)142 emp (ji,jj) = sf(jp_ emp )%fnow(ji,jj,1)99 utau(ji,jj) = sf(jp_otx1)%fnow(ji,jj,1) 100 vtau(ji,jj) = sf(jp_oty1)%fnow(ji,jj,1) 101 qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj,1) - sf(jp_qsroce)%fnow(ji,jj,1) 102 emp (ji,jj) = sf(jp_oemp )%fnow(ji,jj,1) 143 103 END DO 144 104 END DO … … 165 125 WRITE(numout,*) ' read daily momentum, heat and freshwater fluxes OK' 166 126 DO jf = 1, jpfld 167 IF( jf == jp_ utau .OR. jf == jp_vtau) zfact = 1.168 IF( jf == jp_qtot .OR. jf == jp_qsr 169 IF( jf == jp_ emp) zfact = 86400.127 IF( jf == jp_otx1 .OR. jf == jp_oty1 ) zfact = 1. 128 IF( jf == jp_qtot .OR. jf == jp_qsroce ) zfact = 0.1 129 IF( jf == jp_oemp ) zfact = 86400. 170 130 WRITE(numout,*) 171 131 WRITE(numout,*) ' day: ', ndastp , TRIM(sf(jf)%clvar), ' * ', zfact -
branches/UKMO/dev_3841_sbc/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90
r3625 r4827 22 22 USE timing ! Timing 23 23 USE daymod ! calendar 24 USE fld read ! read input fields24 USE fld_def 25 25 26 26 USE sbc_oce ! Surface boundary condition: ocean fields … … 28 28 USE sbcblk_core ! Surface boundary condition: CORE bulk 29 29 USE sbccpl 30 USE sbcget 30 31 31 32 USE ice_kinds_mod … … 62 63 INTEGER , PARAMETER :: ji_off = INT ( (jpiglo - nx_global) / 2 ) 63 64 INTEGER , PARAMETER :: jj_off = INT ( (jpjglo - ny_global) / 2 ) 64 65 INTEGER , PARAMETER :: jpfld = 13 ! maximum number of files to read66 INTEGER , PARAMETER :: jp_snow = 1 ! index of snow file67 INTEGER , PARAMETER :: jp_rain = 2 ! index of rain file68 INTEGER , PARAMETER :: jp_sblm = 3 ! index of sublimation file69 INTEGER , PARAMETER :: jp_top1 = 4 ! index of category 1 topmelt file70 INTEGER , PARAMETER :: jp_top2 = 5 ! index of category 2 topmelt file71 INTEGER , PARAMETER :: jp_top3 = 6 ! index of category 3 topmelt file72 INTEGER , PARAMETER :: jp_top4 = 7 ! index of category 4 topmelt file73 INTEGER , PARAMETER :: jp_top5 = 8 ! index of category 5 topmelt file74 INTEGER , PARAMETER :: jp_bot1 = 9 ! index of category 1 botmelt file75 INTEGER , PARAMETER :: jp_bot2 = 10 ! index of category 2 botmelt file76 INTEGER , PARAMETER :: jp_bot3 = 11 ! index of category 3 botmelt file77 INTEGER , PARAMETER :: jp_bot4 = 12 ! index of category 4 botmelt file78 INTEGER , PARAMETER :: jp_bot5 = 13 ! index of category 5 botmelt file79 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf ! structure of input fields (file informations, fields read)80 65 81 66 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:), PRIVATE :: png ! local array used in sbc_cice_ice … … 655 640 IF( kt == nit000 ) THEN 656 641 IF(lwp) WRITE(numout,*)'cice_sbc_hadgam' 657 IF( sbc_cpl_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_cpl_alloc : unable to allocate arrays' )642 ! IF( sbc_cpl_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_cpl_alloc : unable to allocate arrays' ) 658 643 ENDIF 659 644 … … 705 690 !! 706 691 !!--------------------------------------------------------------------- 707 !! ** Method : READ monthly flux file in NetCDF files692 !! ** Method : Set forcing fields 708 693 !! 709 694 !! snowfall … … 716 701 !!---------------------------------------------------------------------- 717 702 !! * Modules used 718 USE iom 719 720 !! * arguments 703 721 704 INTEGER, INTENT( in ) :: kt ! ocean time step 722 705 723 INTEGER :: ierror ! return error code 724 INTEGER :: ifpr ! dummy loop index 725 !! 726 CHARACTER(len=100) :: cn_dir ! Root directory for location of CICE forcing files 727 TYPE(FLD_N), DIMENSION(jpfld) :: slf_i ! array of namelist informations on the fields to read 728 TYPE(FLD_N) :: sn_snow, sn_rain, sn_sblm ! informations about the fields to be read 729 TYPE(FLD_N) :: sn_top1, sn_top2, sn_top3, sn_top4, sn_top5 730 TYPE(FLD_N) :: sn_bot1, sn_bot2, sn_bot3, sn_bot4, sn_bot5 731 732 !! 733 NAMELIST/namsbc_cice/ cn_dir, sn_snow, sn_rain, sn_sblm, & 734 & sn_top1, sn_top2, sn_top3, sn_top4, sn_top5, & 735 & sn_bot1, sn_bot2, sn_bot3, sn_bot4, sn_bot5 736 !!--------------------------------------------------------------------- 737 738 ! ! ====================== ! 739 IF( kt == nit000 ) THEN ! First call kt=nit000 ! 740 ! ! ====================== ! 741 ! set file information (default values) 742 cn_dir = './' ! directory in which the model is executed 743 744 ! (NB: frequency positive => hours, negative => months) 745 ! ! file ! frequency ! variable ! time intep ! clim ! 'yearly' or ! weights ! rotation ! 746 ! ! name ! (hours) ! name ! (T/F) ! (T/F) ! 'monthly' ! filename ! pairs ! 747 sn_snow = FLD_N( 'snowfall_1m' , -1. , 'snowfall' , .true. , .true. , ' yearly' , '' , '' ) 748 sn_rain = FLD_N( 'rainfall_1m' , -1. , 'rainfall' , .true. , .true. , ' yearly' , '' , '' ) 749 sn_sblm = FLD_N( 'sublim_1m' , -1. , 'sublim' , .true. , .true. , ' yearly' , '' , '' ) 750 sn_top1 = FLD_N( 'topmeltn1_1m' , -1. , 'topmeltn1' , .true. , .true. , ' yearly' , '' , '' ) 751 sn_top2 = FLD_N( 'topmeltn2_1m' , -1. , 'topmeltn2' , .true. , .true. , ' yearly' , '' , '' ) 752 sn_top3 = FLD_N( 'topmeltn3_1m' , -1. , 'topmeltn3' , .true. , .true. , ' yearly' , '' , '' ) 753 sn_top4 = FLD_N( 'topmeltn4_1m' , -1. , 'topmeltn4' , .true. , .true. , ' yearly' , '' , '' ) 754 sn_top5 = FLD_N( 'topmeltn5_1m' , -1. , 'topmeltn5' , .true. , .true. , ' yearly' , '' , '' ) 755 sn_bot1 = FLD_N( 'botmeltn1_1m' , -1. , 'botmeltn1' , .true. , .true. , ' yearly' , '' , '' ) 756 sn_bot2 = FLD_N( 'botmeltn2_1m' , -1. , 'botmeltn2' , .true. , .true. , ' yearly' , '' , '' ) 757 sn_bot3 = FLD_N( 'botmeltn3_1m' , -1. , 'botmeltn3' , .true. , .true. , ' yearly' , '' , '' ) 758 sn_bot4 = FLD_N( 'botmeltn4_1m' , -1. , 'botmeltn4' , .true. , .true. , ' yearly' , '' , '' ) 759 sn_bot5 = FLD_N( 'botmeltn5_1m' , -1. , 'botmeltn5' , .true. , .true. , ' yearly' , '' , '' ) 760 761 ! REWIND ( numnam ) ! ... at some point might read in from NEMO namelist? 762 ! READ ( numnam, namsbc_cice ) 763 764 ! store namelist information in an array 765 slf_i(jp_snow) = sn_snow ; slf_i(jp_rain) = sn_rain ; slf_i(jp_sblm) = sn_sblm 766 slf_i(jp_top1) = sn_top1 ; slf_i(jp_top2) = sn_top2 ; slf_i(jp_top3) = sn_top3 767 slf_i(jp_top4) = sn_top4 ; slf_i(jp_top5) = sn_top5 ; slf_i(jp_bot1) = sn_bot1 768 slf_i(jp_bot2) = sn_bot2 ; slf_i(jp_bot3) = sn_bot3 ; slf_i(jp_bot4) = sn_bot4 769 slf_i(jp_bot5) = sn_bot5 770 771 ! set sf structure 772 ALLOCATE( sf(jpfld), STAT=ierror ) 773 IF( ierror > 0 ) THEN 774 CALL ctl_stop( 'cice_sbc_force: unable to allocate sf structure' ) ; RETURN 775 ENDIF 776 777 DO ifpr= 1, jpfld 778 ALLOCATE( sf(ifpr)%fnow(jpi,jpj,1) ) 779 ALLOCATE( sf(ifpr)%fdta(jpi,jpj,1,2) ) 780 END DO 781 782 ! fill sf with slf_i and control print 783 CALL fld_fill( sf, slf_i, cn_dir, 'cice_sbc_force', 'flux formulation for CICE', 'namsbc_cice' ) 784 ! 785 ENDIF 786 787 CALL fld_read( kt, nn_fsbc, sf ) ! Read input fields and provides the 788 ! ! input fields at the current time-step 706 ! Assume the fluxes have already been obtained somewhere.... 789 707 790 708 ! set the fluxes from read fields … … 792 710 tprecip(:,:) = sf(jp_snow)%fnow(:,:,1)+sf(jp_rain)%fnow(:,:,1) 793 711 ! May be better to do this conversion somewhere else 794 qla_ice(:,:,1) = -Lsub*sf(jp_sblm)%fnow(:,:,1) 795 topmelt(:,:,1) = sf(jp_top1)%fnow(:,:,1) 796 topmelt(:,:,2) = sf(jp_top2)%fnow(:,:,1) 797 topmelt(:,:,3) = sf(jp_top3)%fnow(:,:,1) 798 topmelt(:,:,4) = sf(jp_top4)%fnow(:,:,1) 799 topmelt(:,:,5) = sf(jp_top5)%fnow(:,:,1) 800 botmelt(:,:,1) = sf(jp_bot1)%fnow(:,:,1) 801 botmelt(:,:,2) = sf(jp_bot2)%fnow(:,:,1) 802 botmelt(:,:,3) = sf(jp_bot3)%fnow(:,:,1) 803 botmelt(:,:,4) = sf(jp_bot4)%fnow(:,:,1) 804 botmelt(:,:,5) = sf(jp_bot5)%fnow(:,:,1) 805 806 ! control print (if less than 100 time-step asked) 807 IF( nitend-nit000 <= 100 .AND. lwp ) THEN 808 WRITE(numout,*) 809 WRITE(numout,*) ' read forcing fluxes for CICE OK' 810 CALL FLUSH(numout) 811 ENDIF 712 qla_ice(:,:,1) = -Lsub*sf(jp_ievp)%fnow(:,:,1) 713 topmelt(:,:,:) = sf(jp_topm)%fnow(:,:,:) 714 botmelt(:,:,:) = sf(jp_botm)%fnow(:,:,:) 812 715 813 716 END SUBROUTINE cice_sbc_force -
branches/UKMO/dev_3841_sbc/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
r3764 r4827 37 37 USE sbcice_cice ! surface boundary condition: CICE sea-ice model 38 38 USE sbccpl ! surface boundary condition: coupled florulation 39 USE sbcget 39 40 USE cpl_oasis3, ONLY:lk_cpl ! are we in coupled mode? 40 41 USE sbcssr ! surface boundary condition: sea surface restoring … … 221 222 IF( ln_ssr ) CALL sbc_ssr_init ! Sea-Surface Restoring initialisation 222 223 ! 224 CALL sbc_get_init 225 ! 223 226 IF( nn_ice == 4 ) CALL cice_sbc_init( nsbc ) ! CICE initialisation 224 227 ! … … 258 261 sfx_b(:,:) = sfx(:,:) 259 262 ENDIF 263 ! 264 CALL sbc_get( kt ) 265 ! 260 266 ! ! ---------------------------------------- ! 261 267 ! ! forcing field computation !
Note: See TracChangeset
for help on using the changeset viewer.