Changeset 5352 for branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO
- Timestamp:
- 2015-06-04T17:01:01+02:00 (9 years ago)
- Location:
- branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO
- Files:
-
- 10 edited
-
LIM_SRC_3/limsbc.F90 (modified) (2 diffs)
-
LIM_SRC_3/limthd.F90 (modified) (2 diffs)
-
OPA_SRC/IOM/restart.F90 (modified) (2 diffs)
-
OPA_SRC/SBC/sbc_oce.F90 (modified) (2 diffs)
-
OPA_SRC/SBC/sbccpl.F90 (modified) (3 diffs)
-
OPA_SRC/SBC/sbcssm.F90 (modified) (12 diffs)
-
OPA_SRC/TRA/traqsr.F90 (modified) (5 diffs)
-
OPA_SRC/oce.F90 (modified) (3 diffs)
-
SAS_SRC/nemogcm.F90 (modified) (2 diffs)
-
SAS_SRC/sbcssm.F90 (modified) (9 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90
r5220 r5352 30 30 USE sbc_oce ! Surface boundary condition: ocean fields 31 31 USE sbccpl 32 USE oce , ONLY : fraqsr_1lev,sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass32 USE oce , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 33 33 USE albedo ! albedo parameters 34 34 USE lbclnk ! ocean lateral boundary condition - MPP exchanges … … 346 346 sice_0(:,:) = 2._wp 347 347 END WHERE 348 ENDIF349 350 IF( .NOT. ln_rstart ) THEN351 fraqsr_1lev(:,:) = 1._wp352 348 ENDIF 353 349 ! -
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90
r5299 r5352 22 22 USE phycst ! physical constants 23 23 USE dom_oce ! ocean space and time domain variables 24 USE oce , ONLY : fraqsr_1lev25 24 USE ice ! LIM: sea-ice variables 26 25 USE sbc_oce ! Surface boundary condition: ocean fields … … 172 171 IF ( ln_cpl ) THEN 173 172 zqld = tmask(ji,jj,1) * rdt_ice * & 174 & ( zqsr(ji,jj) * fr aqsr_1lev(ji,jj) + zqns(ji,jj)& ! pfrld already included in coupled mode175 & + ( pfrld(ji,jj)**rn_betas - pfrld(ji,jj) ) * sprecip(ji,jj) *& ! heat content of precip173 & ( zqsr(ji,jj) * frq_m(ji,jj) + zqns(ji,jj) & ! pfrld already included in coupled mode 174 & + ( pfrld(ji,jj)**rn_betas - pfrld(ji,jj) ) * sprecip(ji,jj) * & ! heat content of precip 176 175 & ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rt0 ) - lfus ) & 177 176 & + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rt0 ) ) 178 177 ELSE 179 178 zqld = tmask(ji,jj,1) * rdt_ice * & 180 & ( pfrld(ji,jj) * ( zqsr(ji,jj) * fr aqsr_1lev(ji,jj) + zqns(ji,jj) )&181 & + ( pfrld(ji,jj)**rn_betas - pfrld(ji,jj) ) * sprecip(ji,jj) *& ! heat content of precip182 & ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rt0 ) - lfus ) 179 & ( pfrld(ji,jj) * ( zqsr(ji,jj) * frq_m(ji,jj) + zqns(ji,jj) ) & 180 & + ( pfrld(ji,jj)**rn_betas - pfrld(ji,jj) ) * sprecip(ji,jj) * & ! heat content of precip 181 & ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rt0 ) - lfus ) & 183 182 & + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rt0 ) ) 184 183 ENDIF -
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90
r5299 r5352 135 135 CALL iom_rstput( kt, nitrst, numrow, 'rhd' , rhd ) 136 136 #endif 137 IF( lk_lim3 .OR. ( nn_components == jp_iam_opa ) ) THEN138 CALL iom_rstput( kt, nitrst, numrow, 'fraqsr_1lev' , fraqsr_1lev ) !clem modif139 ENDIF140 137 IF( kt == nitrst ) THEN 141 138 CALL iom_close( numrow ) ! close the restart file (only at last time step) … … 268 265 ENDIF 269 266 ! 270 !EM Idem271 !EM IF( lk_lim3 .OR. ( nn_components == jp_iam_opa ) ) THEN272 CALL iom_get( numror, jpdom_autoglo, 'fraqsr_1lev' , fraqsr_1lev )273 !EM ENDIF274 !275 267 END SUBROUTINE rst_read 276 268 -
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90
r5220 r5352 136 136 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ssh_m !: mean (nn_fsbc time-step) sea surface height [m] 137 137 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e3t_m !: mean (nn_fsbc time-step) sea surface layer thickness [m] 138 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: frq_m !: mean (nn_fsbc time-step) fraction of solar net radiation absorbed in the 1st T level [-] 138 139 139 140 !! * Substitutions … … 169 170 & atm_co2(jpi,jpj) , & 170 171 #endif 171 & ssu_m (jpi,jpj) , sst_m(jpi,jpj) , 172 & ssv_m (jpi,jpj) , sss_m (jpi,jpj), ssh_m(jpi,jpj) , STAT=ierr(4) )172 & ssu_m (jpi,jpj) , sst_m(jpi,jpj) , frq_m(jpi,jpj) , & 173 & ssv_m (jpi,jpj) , sss_m(jpi,jpj) , ssh_m(jpi,jpj) , STAT=ierr(4) ) 173 174 ! 174 175 #if defined key_vvl -
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r5343 r5352 33 33 USE cpl_oasis3 ! OASIS3 coupling 34 34 USE geo2ocean ! 35 USE oce , ONLY : tsn, un, vn, sshn, ub, vb, tsb, sshb , fraqsr_1lev35 USE oce , ONLY : tsn, un, vn, sshn, ub, vb, tsb, sshb 36 36 USE albedo ! 37 37 USE in_out_manager ! I/O manager … … 1027 1027 ! ! fraction of solar net radiation ! 1028 1028 ! ! ================================ ! 1029 IF( srcv(jpr_fraqsr)%laction ) THEN 1030 fr aqsr_1lev(:,:) = frcv(jpr_fraqsr)%z3(:,:,1)1029 IF( srcv(jpr_fraqsr)%laction ) THEN ! received by sas in case of opa <-> sas coupling 1030 frq_m(:,:) = frcv(jpr_fraqsr)%z3(:,:,1) 1031 1031 ENDIF 1032 1032 … … 1880 1880 ELSE ; ztmp1(:,:) = sshn(:,:) 1881 1881 ENDIF 1882 CALL cpl_snd( jps_ssh , isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )1882 CALL cpl_snd( jps_ssh , isec, RESHAPE ( ztmp1 , (/jpi,jpj,1/) ), info ) 1883 1883 1884 1884 ENDIF 1885 1885 ! ! SSS 1886 1886 IF( ssnd(jps_soce )%laction ) THEN 1887 ztmp1(:,:) = tsn(:,:,1,jp_sal) 1888 CALL cpl_snd( jps_soce , isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 1887 CALL cpl_snd( jps_soce , isec, RESHAPE ( tsn(:,:,1,jp_sal), (/jpi,jpj,1/) ), info ) 1889 1888 ENDIF 1890 1889 ! ! first T level thickness 1891 1890 IF( ssnd(jps_e3t1st )%laction ) THEN 1892 ztmp1(:,:) = fse3t_n(:,:,1) 1893 CALL cpl_snd( jps_e3t1st, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 1891 CALL cpl_snd( jps_e3t1st, isec, RESHAPE ( fse3t_n(:,:,1) , (/jpi,jpj,1/) ), info ) 1894 1892 ENDIF 1895 1893 ! ! Qsr fraction 1896 1894 IF( ssnd(jps_fraqsr)%laction ) THEN 1897 ztmp1(:,:) = fraqsr_1lev(:,:) 1898 CALL cpl_snd( jps_fraqsr, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 1895 CALL cpl_snd( jps_fraqsr, isec, RESHAPE ( frq_m , (/jpi,jpj,1/) ), info ) 1899 1896 ENDIF 1900 1897 ! -
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90
r5343 r5352 17 17 USE sbcapr ! surface boundary condition: atmospheric pressure 18 18 USE eosbn2 ! equation of state and related derivatives 19 USE traqsr, ONLY: ln_qsr_ice,fraqsr_1lev 19 20 ! 20 21 USE in_out_manager ! I/O manager … … 59 60 REAL(wp), DIMENSION(jpi,jpj,jpts) :: zts 60 61 !!--------------------------------------------------------------------- 61 62 62 63 ! !* surface T-, U-, V- ocean level variables (T, S, depth, velocity) 63 64 DO jj = 1, jpj … … 81 82 ENDIF 82 83 ! 83 IF( lk_vvl ) fse3t_m(:,:) = fse3t_n(:,:,1) 84 IF( lk_vvl ) e3t_m(:,:) = fse3t_n(:,:,1) 85 ! 86 IF( ln_qsr_ice ) frq_m(:,:) = fraqsr_1lev(:,:) 84 87 ! 85 88 ELSE … … 101 104 ENDIF 102 105 ! 103 IF( lk_vvl ) fse3t_m(:,:) = zcoef * fse3t_n(:,:,1) 106 IF( lk_vvl ) e3t_m(:,:) = zcoef * fse3t_n(:,:,1) 107 ! 108 IF( ln_qsr_ice ) frq_m(:,:) = zcoef * fraqsr_1lev(:,:) 104 109 ! ! ---------------------------------------- ! 105 110 ELSEIF( MOD( kt - 2 , nn_fsbc ) == 0 ) THEN ! Initialisation: New mean computation ! … … 110 115 sss_m(:,:) = 0.e0 111 116 ssh_m(:,:) = 0.e0 112 IF( lk_vvl ) fse3t_m(:,:) = 0.e0 117 IF( lk_vvl ) e3t_m(:,:) = 0.e0 118 IF( ln_qsr_ice ) frq_m(:,:) = 0.e0 113 119 ENDIF 114 120 ! ! ---------------------------------------- ! … … 126 132 ENDIF 127 133 ! 128 IF( lk_vvl ) fse3t_m(:,:) = fse3t_m(:,:) + fse3t_n(:,:,1) 134 IF( lk_vvl ) e3t_m(:,:) = fse3t_m(:,:) + fse3t_n(:,:,1) 135 ! 136 IF( ln_qsr_ice ) frq_m(:,:) = frq_m(:,:) + fraqsr_1lev(:,:) 129 137 130 138 ! ! ---------------------------------------- ! … … 137 145 ssv_m(:,:) = ssv_m(:,:) * zcoef ! 138 146 ssh_m(:,:) = ssh_m(:,:) * zcoef ! mean SSH [m] 139 IF( lk_vvl ) fse3t_m(:,:) = fse3t_m(:,:) * zcoef ! mean vertical scale factor [m] 147 IF( lk_vvl ) e3t_m(:,:) = fse3t_m(:,:) * zcoef ! mean vertical scale factor [m] 148 IF( ln_qsr_ice ) frq_m(:,:) = frq_m(:,:) * zcoef ! mean fraction of solar net radiation absorbed in the 1st T level [-] 140 149 ! 141 150 ENDIF … … 154 163 CALL iom_rstput( kt, nitrst, numrow, 'sss_m' , sss_m ) 155 164 CALL iom_rstput( kt, nitrst, numrow, 'ssh_m' , ssh_m ) 156 IF( lk_vvl ) THEN 157 CALL iom_rstput( kt, nitrst, numrow, 'fse3t_m' , fse3t_m(:,:) ) 158 END IF 165 IF( lk_vvl ) CALL iom_rstput( kt, nitrst, numrow, 'e3t_m' , e3t_m ) 166 IF( ln_qsr_ice ) CALL iom_rstput( kt, nitrst, numrow, 'frq_m' , frq_m ) 159 167 ! 160 168 ENDIF … … 168 176 CALL iom_put( 'sss_m', sss_m ) 169 177 CALL iom_put( 'ssh_m', ssh_m ) 170 IF( lk_vvl ) CALL iom_put( 'e3t_m', fse3t_m(:,:) ) 178 IF( lk_vvl ) CALL iom_put( 'e3t_m', e3t_m ) 179 IF( ln_qsr_ice ) CALL iom_put( 'frq_m', frq_m ) 171 180 ENDIF 172 181 ! … … 204 213 CALL iom_get( numror, jpdom_autoglo, 'sss_m' , sss_m ) ! " " salinity (T-point) 205 214 CALL iom_get( numror, jpdom_autoglo, 'ssh_m' , ssh_m ) ! " " height (T-point) 206 IF( lk_vvl ) CALL iom_get( numror, jpdom_autoglo, 'fse3t_m', fse3t_m(:,:) ) 215 IF( lk_vvl ) CALL iom_get( numror, jpdom_autoglo, 'e3t_m', e3t_m ) 216 ! fraction of solar net radiation absorbed in 1st T level 217 IF( iom_varid( numror, 'frq_m', ldstop = .FALSE. ) > 0 ) THEN 218 CALL iom_get( numror, jpdom_autoglo, 'frq_m' , frq_m ) 219 ELSE 220 frq_m(:,:) = 1._wp ! default definition 221 ENDIF 207 222 ! 208 223 IF( zf_sbc /= REAL( nn_fsbc, wp ) ) THEN ! nn_fsbc has changed between 2 runs … … 215 230 sss_m(:,:) = zcoef * sss_m(:,:) 216 231 ssh_m(:,:) = zcoef * ssh_m(:,:) 217 IF( lk_vvl ) fse3t_m(:,:) = zcoef * fse3t_m(:,:) 232 IF( lk_vvl ) e3t_m(:,:) = zcoef * fse3t_m(:,:) 233 frq_m(:,:) = zcoef * frq_m(:,:) ! bug: must not be done if ln_qsr_ice = .false. 218 234 ELSE 219 235 IF(lwp) WRITE(numout,*) '~~~~~~~ mean fields read in the ocean restart file' … … 232 248 sss_m(:,:) = tsn(:,:,1,jp_sal) 233 249 ssh_m(:,:) = sshn(:,:) 234 IF( lk_vvl ) fse3t_m(:,:) = fse3t_n(:,:,1) 250 IF( lk_vvl ) e3t_m(:,:) = fse3t_n(:,:,1) 251 frq_m(:,:) = 1._wp 235 252 ! 236 253 ENDIF -
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90
r5299 r5352 32 32 USE wrk_nemo ! Memory Allocation 33 33 USE timing ! Timing 34 USE sbc_ice, ONLY : lk_lim335 34 36 35 IMPLICIT NONE … … 50 49 REAL(wp), PUBLIC :: rn_si0 !: very near surface depth of extinction (RGB & 2 bands) 51 50 REAL(wp), PUBLIC :: rn_si1 !: deepest depth of extinction (water type I) (2 bands) 52 51 52 !! Energy budget of the leads (open water embedded in sea ice) 53 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: fraqsr_1lev !: fraction of solar net radiation absorbed in the 1st T level [-] 54 53 55 ! Module variables 54 56 REAL(wp) :: xsi0r !: inverse of rn_si0 … … 165 167 CALL iom_put( 'qsr3d', etot3 ) ! Shortwave Radiation 3D distribution 166 168 ! clem: store attenuation coefficient of the first ocean level 167 IF ( l k_lim3 .AND. ln_qsr_ice ) THEN169 IF ( ln_qsr_ice ) THEN 168 170 DO jj = 1, jpj 169 171 DO ji = 1, jpi 170 172 IF ( qsr(ji,jj) /= 0._wp ) THEN 171 173 fraqsr_1lev(ji,jj) = ( qsr_hc(ji,jj,1) / ( r1_rau0_rcp * qsr(ji,jj) ) ) 174 ELSE 175 fraqsr_1lev(ji,jj) = 1. 172 176 ENDIF 173 177 END DO … … 380 384 IF( nn_timing == 1 ) CALL timing_start('tra_qsr_init') 381 385 ! 382 ! Default value for fraqsr_1lev383 IF( .NOT. ln_rstart ) THEN384 fraqsr_1lev(:,:) = 1._wp385 ENDIF386 !387 386 CALL wrk_alloc( jpi, jpj, zekb, zekg, zekr ) 388 387 CALL wrk_alloc( jpi, jpj, jpk, ze0, ze1, ze2, ze3, zea ) … … 412 411 WRITE(numout,*) ' RGB & 2 bands: shortess depth of extinction rn_si0 = ', rn_si0 413 412 WRITE(numout,*) ' 2 bands: longest depth of extinction rn_si1 = ', rn_si1 414 WRITE(numout,*) ' light penetration for ice-model LIM3 ln_qsr_ice = ', ln_qsr_ice 415 ENDIF 416 413 ENDIF 414 415 ! allocate fraqsr_1lev if we have ln_qsr_ice 416 IF( ln_qsr_ice ) THEN 417 ALLOCATE( fraqsr_1lev(jpi,jpj) , STAT=ierror ) 418 IF( ierror > 0 ) THEN 419 CALL ctl_stop( 'tra_qsr_init: unable to allocate fraqsr_1lev array' ) ; RETURN 420 ENDIF 421 fraqsr_1lev(:,:) = 1._wp ! default definition used in the 1st time step as sbc_ssm is called before tra_qsr 422 ENDIF 423 417 424 IF( ln_traqsr ) THEN ! control consistency 418 425 ! -
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OPA_SRC/oce.F90
r4990 r5352 69 69 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: snwice_fmass !: time evolution of mass of snow+ice [Kg/m2/s] 70 70 71 !! Energy budget of the leads (open water embedded in sea ice)72 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fraqsr_1lev !: fraction of solar net radiation absorbed in the first ocean level [-]73 74 71 !!---------------------------------------------------------------------- 75 72 !! NEMO/OPA 4.0 , NEMO Consortium (2011) … … 83 80 !! *** FUNCTION oce_alloc *** 84 81 !!---------------------------------------------------------------------- 85 INTEGER :: ierr( 4)82 INTEGER :: ierr(3) 86 83 !!---------------------------------------------------------------------- 87 84 ! … … 117 114 ALLOCATE( snwice_mass(jpi,jpj) , snwice_mass_b(jpi,jpj), snwice_fmass(jpi,jpj) , STAT=ierr(3) ) 118 115 ! 119 ALLOCATE( fraqsr_1lev(jpi,jpj) , STAT=ierr(4) )120 !121 116 oce_alloc = MAXVAL( ierr ) 122 117 IF( oce_alloc /= 0 ) CALL ctl_warn('oce_alloc: failed to allocate arrays') -
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90
r5343 r5352 501 501 USE oce , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 502 502 ! 503 INTEGER :: ierr,ierr1,ierr2,ierr3,ierr4,ierr5,ierr6 ,ierr7503 INTEGER :: ierr,ierr1,ierr2,ierr3,ierr4,ierr5,ierr6 504 504 INTEGER :: jpm 505 505 !!---------------------------------------------------------------------- … … 520 520 ALLOCATE( tsb(jpi,jpj,1,jpm) , STAT=ierr5 ) 521 521 ALLOCATE( sshn(jpi,jpj) , STAT=ierr6 ) 522 ALLOCATE( fraqsr_1lev(jpi,jpj), STAT=ierr7 ) 523 524 ierr = ierr + ierr1 + ierr2 + ierr3 + ierr4 + ierr5 + ierr6 + ierr7 522 523 ierr = ierr + ierr1 + ierr2 + ierr3 + ierr4 + ierr5 + ierr6 525 524 ! 526 525 IF( lk_mpp ) CALL mpp_sum( ierr ) -
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/SAS_SRC/sbcssm.F90
r5343 r5352 36 36 PUBLIC sbc_ssm ! called by sbc 37 37 38 CHARACTER(len=100) :: cn_dir !: Root directory for location of ssm files 39 LOGICAL :: ln_3d_uve !: specify whether input velocity data is 3D 38 CHARACTER(len=100) :: cn_dir !: Root directory for location of ssm files 39 LOGICAL :: ln_3d_uve !: specify whether input velocity data is 3D 40 LOGICAL :: ln_read_frq !: specify whether we must read frq or not 40 41 INTEGER :: nfld_3d 41 42 INTEGER :: nfld_2d … … 47 48 INTEGER :: jf_ssh ! index of sea surface height 48 49 INTEGER :: jf_e3t ! index of first T level thickness 50 INTEGER :: jf_frq ! index of fraction of qsr absorbed in the 1st T level 49 51 50 52 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_ssm_3d ! structure of input fields (file information, fields read) … … 95 97 sss_m(:,:) = sf_ssm_2d(jf_sal)%fnow(:,:,1) * tmask(:,:,1) ! salinity 96 98 ssh_m(:,:) = sf_ssm_2d(jf_ssh)%fnow(:,:,1) * tmask(:,:,1) ! sea surface height 99 IF( ln_read_frq ) frq_m(:,:) = sf_ssm_2d(jf_frq)%fnow(:,:,1) * tmask(:,:,1) ! sea surface height 97 100 ! 98 101 tsn(:,:,1,jp_tem) = sst_m(:,:) … … 111 114 CALL prt_ctl(tab2d_1=ssv_m, clinfo1=' ssv_m - : ', mask1=vmask, ovlap=1 ) 112 115 CALL prt_ctl(tab2d_1=ssh_m, clinfo1=' ssh_m - : ', mask1=tmask, ovlap=1 ) 113 IF( lk_vvl ) CALL prt_ctl(tab2d_1=ssh_m, clinfo1=' e3t_m - : ', mask1=tmask, ovlap=1 ) 116 IF( lk_vvl ) CALL prt_ctl(tab2d_1=ssh_m, clinfo1=' e3t_m - : ', mask1=tmask, ovlap=1 ) 117 IF( ln_read_frq ) CALL prt_ctl(tab2d_1=frq_m, clinfo1=' frq_m - : ', mask1=tmask, ovlap=1 ) 114 118 ENDIF 115 119 ! … … 138 142 TYPE(FLD_N) :: sn_tem, sn_sal ! information about the fields to be read 139 143 TYPE(FLD_N) :: sn_usp, sn_vsp 140 TYPE(FLD_N) :: sn_ssh, sn_e3t 141 ! 142 NAMELIST/namsbc_sas/cn_dir, ln_3d_uve, sn_tem, sn_sal, sn_usp, sn_vsp, sn_ssh, sn_e3t144 TYPE(FLD_N) :: sn_ssh, sn_e3t, sn_frq 145 ! 146 NAMELIST/namsbc_sas/cn_dir, ln_3d_uve, ln_read_frq, sn_tem, sn_sal, sn_usp, sn_vsp, sn_ssh, sn_e3t, sn_frq 143 147 !!---------------------------------------------------------------------- 144 148 … … 159 163 WRITE(numout,*) '~~~~~~~~~~~ ' 160 164 WRITE(numout,*) ' Namelist namsbc_sas' 165 WRITE(numout,*) ' Are we supplying a 3D u,v and e3 field ln_3d_uve = ', ln_3d_uve 166 WRITE(numout,*) ' Are we reading frq (fraction of qsr absorbed in the 1st T level) ln_read_frq = ', ln_read_frq 161 167 WRITE(numout,*) 162 168 ENDIF … … 199 205 !! and the rest of the logic should still work 200 206 ! 201 jf_tem = 1 ; jf_sal = 2 ; jf_ssh = 3 207 jf_tem = 1 ; jf_sal = 2 ; jf_ssh = 3 ; jf_frq = 4 ! default 2D fields index 202 208 ! 203 209 IF( ln_3d_uve ) THEN 204 jf_usp = 1 ; jf_vsp = 2 ; jf_e3t = 3 205 nfld_3d = 2 + COUNT( (/lk_vvl/) ) 206 nfld_2d = 3 210 jf_usp = 1 ; jf_vsp = 2 ; jf_e3t = 3 ! define 3D fields index 211 nfld_3d = 2 + COUNT( (/lk_vvl/) ) ! number of 3D fields to read 212 nfld_2d = 3 + COUNT( (/ln_read_frq/) ) ! number of 2D fields to read 207 213 ELSE 208 jf_usp = 4 ; jf_vsp = 5 ; jf_e3t = 6 209 nfld_3d = 0 210 nfld_2d = 5 + COUNT( (/lk_vvl/) ) 214 jf_usp = 4 ; jf_vsp = 5 ; jf_e3t = 6 ; jf_frq = 6 + COUNT( (/lk_vvl/) ) ! update 2D fields index 215 nfld_3d = 0 ! no 3D fields to read 216 nfld_2d = 5 + COUNT( (/lk_vvl/) ) + COUNT( (/ln_read_frq/) ) ! number of 2D fields to read 211 217 ENDIF 212 218 … … 227 233 ENDIF 228 234 slf_2d(jf_tem) = sn_tem ; slf_2d(jf_sal) = sn_sal ; slf_2d(jf_ssh) = sn_ssh 235 IF( ln_read_frq ) slf_2d(jf_frq) = sn_frq 229 236 IF( .NOT. ln_3d_uve ) THEN 230 237 slf_2d(jf_usp) = sn_usp ; slf_2d(jf_vsp) = sn_vsp … … 271 278 IF( nfld_2d > 0 ) DEALLOCATE( slf_2d, STAT=ierr ) 272 279 273 call sbc_ssm( nit000 ) ! need to define ss?_m arrays used in limistate 280 CALL sbc_ssm( nit000 ) ! need to define ss?_m arrays used in limistate 281 IF( .NOT. ln_read_frq ) frq_m(:,:) = 1. 274 282 ! 275 283 END SUBROUTINE sbc_ssm_init
Note: See TracChangeset
for help on using the changeset viewer.
