Changeset 7120
- Timestamp:
- 2016-10-26T18:28:31+02:00 (7 years ago)
- Location:
- branches/UKMO/r5936_CO6_CO5_zenv_pomsdwl/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 2 added
- 9 edited
-
DOM/dom_oce.F90 (modified) (3 diffs)
-
DOM/domzgr.F90 (modified) (9 diffs)
-
SBC/inv_bar_vel_mod.F90 (added)
-
SBC/sbc_oce.F90 (modified) (2 diffs)
-
SBC/sbcflx.F90 (modified) (7 diffs)
-
SBC/sbcssr.F90 (modified) (5 diffs)
-
TRA/tradwl.F90 (added)
-
TRA/trasbc.F90 (modified) (2 diffs)
-
step.F90 (modified) (2 diffs)
-
step_oce.F90 (modified) (2 diffs)
-
trc_oce.F90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/r5936_CO6_CO5_zenv_pomsdwl/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90
r7116 r7120 181 181 LOGICAL, PUBLIC :: ln_zps !: z-coordinate - partial step 182 182 LOGICAL, PUBLIC :: ln_sco !: s-coordinate or hybrid z-s coordinate 183 LOGICAL, PUBLIC :: ln_read_zenv !: Read or Calcualte zenv 183 184 LOGICAL, PUBLIC :: ln_isfcav !: presence of ISF 184 185 … … 244 245 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hift , hifu !: and quasi-uniform spacing t--u points (m) 245 246 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rx1 !: Maximum grid stiffness ratio 247 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: zenv !: Envelope Bathymetry 246 248 247 249 !!---------------------------------------------------------------------- … … 387 389 & tmask_i(jpi,jpj) , umask_i(jpi,jpj), vmask_i(jpi,jpj), fmask_i(jpi,jpj), & 388 390 & bmask (jpi,jpj) , & 389 & mbkt (jpi,jpj) , mbku (jpi,jpj) , mbkv(jpi,jpj) , STAT=ierr(9) )391 & mbkt (jpi,jpj) , mbku (jpi,jpj) , mbkv(jpi,jpj) , zenv(jpi,jpj) , STAT=ierr(9) ) 390 392 391 393 ! (ISF) Allocation of basic array -
branches/UKMO/r5936_CO6_CO5_zenv_pomsdwl/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90
r7116 r7120 102 102 INTEGER :: ios 103 103 ! 104 NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco, ln_isfcav 104 NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco, ln_isfcav, ln_read_zenv 105 105 !!---------------------------------------------------------------------- 106 106 ! … … 125 125 WRITE(numout,*) ' s- or hybrid z-s-coordinate ln_sco = ', ln_sco 126 126 WRITE(numout,*) ' ice shelf cavities ln_isfcav = ', ln_isfcav 127 WRITE(numout,*) ' Read zenv from Bathy T/F ln_read_zenv = ', ln_read_zenv 127 128 ENDIF 128 129 … … 531 532 ELSE 532 533 CALL iom_get ( inum, jpdom_data, 'Bathymetry' , bathy, lrowattr=ln_use_jattr ) 534 IF ( ln_read_zenv ) THEN ! Whether we should read zenv or not 535 CALL iom_get ( inum, jpdom_data, 'zenv', zenv ) 536 ENDIF 533 537 END IF 534 538 CALL iom_close( inum ) … … 1809 1813 ! 1810 1814 REAL(wp), POINTER, DIMENSION(:,: ) :: ztmpi1, ztmpi2, ztmpj1, ztmpj2 1811 REAL(wp), POINTER, DIMENSION(:,: ) :: z env, ztmp, zmsk, zri, zrj, zhbat1815 REAL(wp), POINTER, DIMENSION(:,: ) :: ztmp, zmsk, zri, zrj, zhbat 1812 1816 1813 1817 NAMELIST/namzgr_sco/ln_s_sh94, ln_s_sf12, ln_sigcrit, rn_sbot_min, rn_sbot_max, rn_hc, rn_rmax,rn_theta, & … … 1817 1821 IF( nn_timing == 1 ) CALL timing_start('zgr_sco') 1818 1822 ! 1819 CALL wrk_alloc( jpi, jpj, z env, ztmp, zmsk, zri, zrj, zhbat , ztmpi1, ztmpi2, ztmpj1, ztmpj2 )1823 CALL wrk_alloc( jpi, jpj, ztmp, zmsk, zri, zrj, zhbat , ztmpi1, ztmpi2, ztmpj1, ztmpj2 ) 1820 1824 ! 1821 1825 REWIND( numnam_ref ) ! Namelist namzgr_sco in reference namelist : Sigma-stretching parameters … … 1871 1875 ! ! ============================= 1872 1876 ! use r-value to create hybrid coordinates 1877 scosrf(:,:) = 0._wp ! ocean surface depth (here zero: no under ice-shelf sea) 1878 scobot(:,:) = bathy(:,:) ! ocean bottom depth 1879 IF( ln_read_zenv) THEN 1880 WRITE(numout,*) ' Zenv is not calculated but read from Bathy File ln_read_zenv = ', ln_read_zenv 1881 ELSE 1873 1882 zenv(:,:) = bathy(:,:) 1874 1883 ! … … 1892 1901 ! 1893 1902 ! smooth the bathymetry (if required) 1894 scosrf(:,:) = 0._wp ! ocean surface depth (here zero: no under ice-shelf sea)1895 scobot(:,:) = bathy(:,:) ! ocean bottom depth1896 1903 ! 1897 1904 jl = 0 … … 1957 1964 END DO ! End loop ! 1958 1965 ! ! ================ ! 1966 ENDIF ! End of IF Block for reading in zenv 1967 CALL lbc_lnk( zenv, 'T', 1._wp, 'no0' ) 1959 1968 DO jj = 1, jpj 1960 1969 DO ji = 1, jpi … … 2232 2241 END DO 2233 2242 ! 2234 CALL wrk_dealloc( jpi, jpj, z env, ztmp, zmsk, zri, zrj, zhbat , ztmpi1, ztmpi2, ztmpj1, ztmpj2 )2243 CALL wrk_dealloc( jpi, jpj, ztmp, zmsk, zri, zrj, zhbat , ztmpi1, ztmpi2, ztmpj1, ztmpj2 ) 2235 2244 ! 2236 2245 IF( nn_timing == 1 ) CALL timing_stop('zgr_sco') -
branches/UKMO/r5936_CO6_CO5_zenv_pomsdwl/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90
r7116 r7120 120 120 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sprecip !: solid precipitation [Kg/m2/s] 121 121 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fr_i !: ice fraction = 1 - lead fraction (between 0 to 1) 122 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: pressnow !: UKMO SHELF pressure 123 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: apgu !: UKMO SHELF pressure forcing 124 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: apgv !: UKMO SHELF pressure forcing 122 125 #if defined key_cpl_carbon_cycle 123 126 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: atm_co2 !: atmospheric pCO2 [ppm] … … 170 173 #endif 171 174 & ssu_m (jpi,jpj) , sst_m(jpi,jpj) , frq_m(jpi,jpj) , & 175 & pressnow(jpi,jpj), apgu(jpi,jpj) , apgv(jpi,jpj) , & 172 176 & ssv_m (jpi,jpj) , sss_m(jpi,jpj) , ssh_m(jpi,jpj) , STAT=ierr(4) ) 173 177 ! -
branches/UKMO/r5936_CO6_CO5_zenv_pomsdwl/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90
r7116 r7120 28 28 PUBLIC sbc_flx ! routine called by step.F90 29 29 30 INTEGER , PARAMETER :: jpfld = 5! maximum number of files to read30 INTEGER , PARAMETER :: jpfld = 6 ! maximum number of files to read 31 31 INTEGER , PARAMETER :: jp_utau = 1 ! index of wind stress (i-component) file 32 32 INTEGER , PARAMETER :: jp_vtau = 2 ! index of wind stress (j-component) file … … 34 34 INTEGER , PARAMETER :: jp_qsr = 4 ! index of solar heat file 35 35 INTEGER , PARAMETER :: jp_emp = 5 ! index of evaporation-precipation file 36 INTEGER , PARAMETER :: jp_press = 6 ! index of pressure for UKMO shelf fluxes 36 37 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf ! structure of input fields (file informations, fields read) 38 LOGICAL , PUBLIC :: ln_shelf_flx = .FALSE. ! UKMO SHELF specific flux flag 39 INTEGER :: jpfld_local ! maximum number of files to read (locally modified depending on ln_shelf_flx) 37 40 38 41 !! * Substitutions … … 82 85 REAL(wp) :: zcdrag = 1.5e-3 ! drag coefficient 83 86 REAL(wp) :: ztx, zty, zmod, zcoef ! temporary variables 87 REAL :: cs ! UKMO SHELF: Friction co-efficient at surface 88 REAL :: totwindspd ! UKMO SHELF: Magnitude of wind speed vector 89 90 REAL(wp) :: rhoa = 1.22 ! Air density kg/m3 91 REAL(wp) :: cdrag = 1.5e-3 ! drag coefficient 84 92 !! 85 93 CHARACTER(len=100) :: cn_dir ! Root directory for location of flx files 86 94 TYPE(FLD_N), DIMENSION(jpfld) :: slf_i ! array of namelist information structures 87 TYPE(FLD_N) :: sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp ! informations about the fields to be read 88 NAMELIST/namsbc_flx/ cn_dir, sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp 95 TYPE(FLD_N) :: sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp, sn_press ! informations about the fields to be read 96 LOGICAL :: ln_foam_flx = .FALSE. ! UKMO FOAM specific flux flag 97 NAMELIST/namsbc_flx/ cn_dir, sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp, & 98 & ln_foam_flx, sn_press, ln_shelf_flx 89 99 !!--------------------------------------------------------------------- 90 100 ! … … 109 119 slf_i(jp_emp ) = sn_emp 110 120 ! 111 ALLOCATE( sf(jpfld), STAT=ierror ) ! set sf structure 121 ALLOCATE( sf(jpfld), STAT=ierror ) ! set sf structure 122 IF( ln_shelf_flx ) slf_i(jp_press) = sn_press 123 124 ! define local jpfld depending on shelf_flx logical 125 IF( ln_shelf_flx ) THEN 126 jpfld_local = jpfld 127 ELSE 128 jpfld_local = jpfld-1 129 ENDIF 130 ! 112 131 IF( ierror > 0 ) THEN 113 132 CALL ctl_stop( 'sbc_flx: unable to allocate sf structure' ) ; RETURN 114 133 ENDIF 115 DO ji= 1, jpfld 134 DO ji= 1, jpfld_local 116 135 ALLOCATE( sf(ji)%fnow(jpi,jpj,1) ) 117 136 IF( slf_i(ji)%ln_tint ) ALLOCATE( sf(ji)%fdta(jpi,jpj,1,2) ) … … 131 150 ELSE ; qsr(:,:) = sf(jp_qsr)%fnow(:,:,1) 132 151 ENDIF 152 !!UKMO SHELF effect of atmospheric pressure on SSH 153 ! If using ln_apr_dyn, this is done there so don't repeat here. 154 IF( ln_shelf_flx .AND. .NOT. ln_apr_dyn) THEN 155 DO jj = 1, jpjm1 156 DO ji = 1, jpim1 157 apgu(ji,jj) = (-1.0/rau0)*(sf(jp_press)%fnow(ji+1,jj,1)-sf(jp_press)%fnow(ji,jj,1))/e1u(ji,jj) 158 apgv(ji,jj) = (-1.0/rau0)*(sf(jp_press)%fnow(ji,jj+1,1)-sf(jp_press)%fnow(ji,jj,1))/e2v(ji,jj) 159 END DO 160 END DO 161 ENDIF ! ln_shelf_flx 162 133 163 DO jj = 1, jpj ! set the ocean fluxes from read fields 134 164 DO ji = 1, jpi 135 utau(ji,jj) = sf(jp_utau)%fnow(ji,jj,1) 136 vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1) 137 qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj,1) - sf(jp_qsr)%fnow(ji,jj,1) 138 emp (ji,jj) = sf(jp_emp )%fnow(ji,jj,1) 165 IF( ln_shelf_flx ) THEN 166 !! UKMO SHELF - need atmospheric pressure to calculate Haney forcing 167 pressnow(ji,jj) = sf(jp_press)%fnow(ji,jj,1) 168 !! UKMO SHELF flux files contain wind speed not wind stress 169 totwindspd = sqrt((sf(jp_utau)%fnow(ji,jj,1))**2.0 + (sf(jp_vtau)%fnow(ji,jj,1))**2.0) 170 cs = 0.63 + (0.066 * totwindspd) 171 utau(ji,jj) = cs * (rhoa/rau0) * sf(jp_utau)%fnow(ji,jj,1) * totwindspd 172 vtau(ji,jj) = cs * (rhoa/rau0) * sf(jp_vtau)%fnow(ji,jj,1) * totwindspd 173 ELSE 174 utau(ji,jj) = sf(jp_utau)%fnow(ji,jj,1) 175 vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1) 176 ENDIF 177 qsr (ji,jj) = sf(jp_qsr )%fnow(ji,jj,1) 178 IF( ln_foam_flx .OR. ln_shelf_flx ) THEN 179 !! UKMO FOAM flux files contain non-solar heat flux (qns) rather than total heat flux (qtot) 180 qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj,1) 181 !! UKMO FOAM flux files contain the net DOWNWARD freshwater flux P-E rather then E-P 182 emp (ji,jj) = -1. * sf(jp_emp)%fnow(ji,jj,1) 183 ELSE 184 qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj,1) - sf(jp_qsr)%fnow(ji,jj,1) 185 emp (ji,jj) = sf(jp_emp )%fnow(ji,jj,1) 186 ENDIF 139 187 END DO 140 188 END DO … … 142 190 qns(:,:) = qns(:,:) - emp(:,:) * sst_m(:,:) * rcp ! mass flux is at SST 143 191 ! 192 !! UKMO FOAM wind fluxes need lbc_lnk calls owing to a bug in interp.exe 193 IF( ln_foam_flx ) THEN 194 CALL lbc_lnk( utau(:,:), 'U', -1. ) 195 CALL lbc_lnk( vtau(:,:), 'V', -1. ) 196 ENDIF 144 197 ! ! module of wind stress and wind speed at T-point 145 198 zcoef = 1. / ( zrhoa * zcdrag ) … … 159 212 WRITE(numout,*) 160 213 WRITE(numout,*) ' read daily momentum, heat and freshwater fluxes OK' 161 DO jf = 1, jpfld 214 DO jf = 1, jpfld_local 162 215 IF( jf == jp_utau .OR. jf == jp_vtau ) zfact = 1. 163 216 IF( jf == jp_qtot .OR. jf == jp_qsr ) zfact = 0.1 -
branches/UKMO/r5936_CO6_CO5_zenv_pomsdwl/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90
r7116 r7120 42 42 LOGICAL :: ln_sssr_bnd ! flag to bound erp term 43 43 REAL(wp) :: rn_sssr_bnd ! ABS(Max./Min.) value of erp term [mm/day] 44 LOGICAL :: ln_UKMO_haney ! UKMO specific flag to calculate Haney forcing 44 45 45 46 REAL(wp) , ALLOCATABLE, DIMENSION(:) :: buffer ! Temporary buffer for exchange … … 79 80 INTEGER :: ierror ! return error code 80 81 !! 82 REAL(wp) :: sst1,sst2 ! sea surface temperature 83 REAL(wp) :: e_sst1, e_sst2 ! saturation vapour pressure 84 REAL(wp) :: qs1,qs2 ! specific humidity 85 REAL(wp) :: pr_tmp ! temporary variable for pressure 86 87 REAL(wp), DIMENSION(jpi,jpj) :: hny_frc1 ! Haney forcing for sensible heat, correction for latent heat 88 REAL(wp), DIMENSION(jpi,jpj) :: hny_frc2 ! Haney forcing for sensible heat, correction for latent heat 89 !! 81 90 CHARACTER(len=100) :: cn_dir ! Root directory for location of ssr files 82 91 TYPE(FLD_N) :: sn_sst, sn_sss ! informations about the fields to be read … … 95 104 ! 96 105 IF( nn_sstr == 1 ) THEN !* Temperature restoring term 97 DO jj = 1, jpj 98 DO ji = 1, jpi 99 zqrp = rn_dqdt * ( sst_m(ji,jj) - sf_sst(1)%fnow(ji,jj,1) ) 100 qns(ji,jj) = qns(ji,jj) + zqrp 101 qrp(ji,jj) = zqrp 102 END DO 103 END DO 106 IF( ln_UKMO_haney ) THEN 107 DO jj = 1, jpj 108 DO ji = 1, jpi 109 sst1 = sst_m(ji,jj) 110 sst2 = sf_sst(1)%fnow(ji,jj,1) 111 e_sst1 = 10**((0.7859+0.03477*sst1)/(1.+0.00412*sst1)) 112 e_sst2 = 10**((0.7859+0.03477*sst2)/(1.+0.00412*sst2)) 113 pr_tmp = 0.01*pressnow(ji,jj) !pr_tmp = 1012.0 114 qs1 = (0.62197*e_sst1)/(pr_tmp-0.378*e_sst1) 115 qs2 = (0.62197*e_sst2)/(pr_tmp-0.378*e_sst2) 116 hny_frc1(ji,jj) = sst1-sst2 117 hny_frc2(ji,jj) = qs1-qs2 118 !Might need to mask off land points. 119 hny_frc1(ji,jj)=-hny_frc1(ji,jj)*wndm(ji,jj)*1.42 120 hny_frc2(ji,jj)=-hny_frc2(ji,jj)*wndm(ji,jj)*4688.0 121 qns(ji,jj)=qns(ji,jj)+hny_frc1(ji,jj)+hny_frc2(ji,jj) 122 qrp(ji,jj) = 0.e0 123 END DO 124 END DO 125 ELSE 126 DO jj = 1, jpj 127 DO ji = 1, jpi 128 zqrp = rn_dqdt * ( sst_m(ji,jj) - sf_sst(1)%fnow(ji,jj,1) ) 129 qns(ji,jj) = qns(ji,jj) + zqrp 130 qrp(ji,jj) = zqrp 131 END DO 132 END DO 133 ENDIF 104 134 CALL iom_put( "qrp", qrp ) ! heat flux damping 105 135 ENDIF … … 161 191 CHARACTER(len=100) :: cn_dir ! Root directory for location of ssr files 162 192 TYPE(FLD_N) :: sn_sst, sn_sss ! informations about the fields to be read 163 NAMELIST/namsbc_ssr/ cn_dir, nn_sstr, nn_sssr, rn_dqdt, rn_deds, sn_sst, sn_sss, ln_sssr_bnd, rn_sssr_bnd 193 NAMELIST/namsbc_ssr/ cn_dir, nn_sstr, nn_sssr, rn_dqdt, rn_deds, sn_sst, sn_sss, ln_sssr_bnd, rn_sssr_bnd, ln_UKMO_haney 164 194 INTEGER :: ios 165 195 !!---------------------------------------------------------------------- … … 187 217 WRITE(numout,*) ' flag to bound erp term ln_sssr_bnd = ', ln_sssr_bnd 188 218 WRITE(numout,*) ' ABS(Max./Min.) erp threshold rn_sssr_bnd = ', rn_sssr_bnd, ' mm/day' 219 WRITE(numout,*) ' Haney forcing ln_UKMO_haney = ', ln_UKMO_haney 189 220 ENDIF 190 221 ! -
branches/UKMO/r5936_CO6_CO5_zenv_pomsdwl/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90
r7116 r7120 25 25 USE trd_oce ! trends: ocean variables 26 26 USE trdtra ! trends manager: tracers 27 USE tradwl ! solar radiation penetration (downwell method) 27 28 ! 28 29 USE in_out_manager ! I/O manager … … 138 139 139 140 !!gm IF( .NOT.ln_traqsr ) qsr(:,:) = 0.e0 ! no solar radiation penetration 140 IF( .NOT.ln_traqsr ) THEN ! no solar radiation penetration141 IF( .NOT.ln_traqsr .and. .NOT.ln_tradwl ) THEN ! no solar radiation penetration 141 142 qns(:,:) = qns(:,:) + qsr(:,:) ! total heat flux in qns 142 143 qsr(:,:) = 0.e0 ! qsr set to zero -
branches/UKMO/r5936_CO6_CO5_zenv_pomsdwl/NEMOGCM/NEMO/OPA_SRC/step.F90
r7116 r7120 218 218 CALL dyn_vor ( kstp ) ! vorticity term including Coriolis 219 219 CALL dyn_ldf ( kstp ) ! lateral mixing 220 IF ( ln_shelf_flx .AND. & 221 & .NOT. ln_apr_dyn) CALL inv( kstp ) ! modification to vel from atmos pres 220 222 CALL dyn_hpg ( kstp ) ! horizontal gradient of Hydrostatic pressure 221 223 CALL dyn_spg ( kstp ) ! surface pressure gradient … … 260 262 CALL tra_sbc ( kstp ) ! surface boundary condition 261 263 IF( ln_traqsr ) CALL tra_qsr ( kstp ) ! penetrative solar radiation qsr 264 IF( ln_tradwl ) CALL tra_dwl ( kstp ) ! Polcoms Style Short Wave Radiation 262 265 IF( ln_trabbc ) CALL tra_bbc ( kstp ) ! bottom heat flux 263 266 IF( lk_trabbl ) CALL tra_bbl ( kstp ) ! advective (and/or diffusive) bottom boundary layer scheme -
branches/UKMO/r5936_CO6_CO5_zenv_pomsdwl/NEMOGCM/NEMO/OPA_SRC/step_oce.F90
r7116 r7120 17 17 USE sbcrnf ! surface boundary condition: runoff variables 18 18 USE sbccpl ! surface boundary condition: coupled formulation (call send at end of step) 19 USE sbcflx ! surface boundary condition: Fluxes 19 20 USE sbcapr ! surface boundary condition: atmospheric pressure 20 21 USE sbctide ! Tide initialisation 21 22 22 23 USE traqsr ! solar radiation penetration (tra_qsr routine) 24 USE tradwl ! POLCOMS style solar radiation (tra_dwl routine) 23 25 USE trasbc ! surface boundary condition (tra_sbc routine) 24 26 USE trabbc ! bottom boundary condition (tra_bbc routine) … … 54 56 55 57 USE sshwzv ! vertical velocity and ssh (ssh_nxt routine) 58 USE inv_bar_vel_mod ! Atmos press effect on vel 56 59 ! (ssh_swp routine) 57 60 ! (wzv routine) -
branches/UKMO/r5936_CO6_CO5_zenv_pomsdwl/NEMOGCM/NEMO/OPA_SRC/trc_oce.F90
r7116 r7120 27 27 REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: etot3 !: light absortion coefficient 28 28 REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: facvol !: volume for degraded regions 29 REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:) :: rlambda2 !: Lambda2 for downwell version of Short wave Radiation 30 REAL(wp), PUBLIC :: rlambda !: Lambda for downwell version of Short wave Radiation 29 31 30 32 #if defined key_top … … 78 80 !! *** trc_oce_alloc *** 79 81 !!---------------------------------------------------------------------- 80 INTEGER :: ierr( 2) ! Local variables82 INTEGER :: ierr(3) ! Local variables 81 83 !!---------------------------------------------------------------------- 82 84 ierr(:) = 0 83 85 ALLOCATE( etot3 (jpi,jpj,jpk), STAT=ierr(1) ) 84 86 IF( lk_degrad) ALLOCATE( facvol(jpi,jpj,jpk), STAT=ierr(2) ) 87 ALLOCATE( rlambda2(jpi,jpj), STAT=ierr(3) ) 85 88 trc_oce_alloc = MAXVAL( ierr ) 86 89 ! 87 IF( trc_oce_alloc /= 0 ) CALL ctl_warn('trc_oce_alloc: failed to allocate etot3 array') 90 ! IF( trc_oce_alloc /= 0 ) CALL ctl_warn('trc_oce_alloc: failed to allocate etot3 array') 91 IF( trc_oce_alloc /= 0 ) CALL ctl_warn('trc_oce_alloc: failed to allocate etot3, facvol or rlambda2 array') 88 92 END FUNCTION trc_oce_alloc 89 93
Note: See TracChangeset
for help on using the changeset viewer.
