Changeset 7965
- Timestamp:
- 2017-04-25T13:18:30+02:00 (7 years ago)
- Location:
- branches/UKMO/dev_r5518_GO6_missing_STABLE_revs/NEMOGCM
- Files:
-
- 1 deleted
- 19 edited
- 6 copied
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_GO6_missing_STABLE_revs/NEMOGCM/CONFIG/SHARED/field_def.xml
r7747 r7965 302 302 <field id="emp_x_sst" long_name="Concentration/Dilution term on SST" unit="kg*degree_C/m2/s" /> 303 303 <field id="emp_x_sss" long_name="Concentration/Dilution term on SSS" unit="kg*0.001/m2/s" /> 304 <field id="rnf_x_sst" long_name="Runoff term on SST" unit="kg*degC/m2/s" /> 305 <field id="rnf_x_sss" long_name="Runoff term on SSS" unit="kg*1e-3/m2/s" /> 304 306 305 307 <field id="iceconc" long_name="ice concentration" standard_name="sea_ice_area_fraction" unit="%" /> -
branches/UKMO/dev_r5518_GO6_missing_STABLE_revs/NEMOGCM/NEMO/LIM_SRC_3/ice.F90
r6498 r7965 234 234 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_oce, v_oce !: surface ocean velocity used in ice dynamics 235 235 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ahiu , ahiv !: hor. diffusivity coeff. at U- and V-points [m2/s] 236 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: pahu , pahv !: ice hor. eddy diffusivity coef. at U- and V-points237 236 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ust2s, hicol !: friction velocity, ice collection thickness accreted in leads 238 237 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: strp1, strp2 !: strength at previous time steps … … 303 302 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_res !: residual heat flux due to correction of ice thickness [W.m-2] 304 303 305 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ftr_ice !: transmitted solar radiation under ice 304 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ftr_ice !: transmitted solar radiation under ice 305 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: pahu3D , pahv3D 306 306 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rn_amax_2d !: maximum ice concentration 2d array 307 307 … … 429 429 ALLOCATE( u_oce (jpi,jpj) , v_oce (jpi,jpj) , & 430 430 & ahiu (jpi,jpj) , ahiv (jpi,jpj) , & 431 & pahu (jpi,jpj) , pahv (jpi,jpj) , &432 431 & ust2s (jpi,jpj) , hicol (jpi,jpj) , & 433 432 & strp1 (jpi,jpj) , strp2 (jpi,jpj) , strength (jpi,jpj) , & … … 442 441 & wfx_res(jpi,jpj) , wfx_sni(jpi,jpj) , wfx_opw(jpi,jpj) , wfx_spr(jpi,jpj) , & 443 442 & afx_tot(jpi,jpj) , afx_thd(jpi,jpj), afx_dyn(jpi,jpj) , & 444 & fhtur (jpi,jpj) , ftr_ice(jpi,jpj,jpl), qlead (jpi,jpj) ,&445 & rn_amax_2d(jpi,jpj),&446 & sfx_res(jpi,jpj) , sfx_bri(jpi,jpj) , sfx_dyn(jpi,jpj) , sfx_sub(jpi,jpj) ,&443 & fhtur (jpi,jpj) , ftr_ice(jpi,jpj,jpl), pahu3D(jpi,jpj,jpl+1), pahv3D(jpi,jpj,jpl+1), & 444 & qlead (jpi,jpj) , rn_amax_2d(jpi,jpj), & 445 & sfx_res(jpi,jpj) , sfx_bri(jpi,jpj) , sfx_dyn(jpi,jpj) , sfx_sub(jpi,jpj), & 447 446 & sfx_bog(jpi,jpj) , sfx_bom(jpi,jpj) , sfx_sum(jpi,jpj) , sfx_sni(jpi,jpj) , sfx_opw(jpi,jpj) , & 448 447 & hfx_res(jpi,jpj) , hfx_snw(jpi,jpj) , hfx_sub(jpi,jpj) , hfx_err(jpi,jpj) , & … … 514 513 !!====================================================================== 515 514 END MODULE ice 515 -
branches/UKMO/dev_r5518_GO6_missing_STABLE_revs/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90
r6486 r7965 7 7 !! - ! 2001-05 (G. Madec, R. Hordoir) opa norm 8 8 !! 1.0 ! 2002-08 (C. Ethe) F90, free form 9 !! 3.0 ! 2015-08 (O. Tintó and M. Castrillo) added lim_hdf (multiple) 9 10 !!---------------------------------------------------------------------- 10 11 #if defined key_lim3 … … 27 28 PRIVATE 28 29 29 PUBLIC lim_hdf 30 PUBLIC lim_hdf ! called by lim_trp 30 31 PUBLIC lim_hdf_init ! called by sbc_lim_init 31 32 … … 43 44 CONTAINS 44 45 45 SUBROUTINE lim_hdf( ptab )46 SUBROUTINE lim_hdf( ptab , ihdf_vars , jpl , nlay_i ) 46 47 !!------------------------------------------------------------------- 47 48 !! *** ROUTINE lim_hdf *** … … 54 55 !! ** Action : update ptab with the diffusive contribution 55 56 !!------------------------------------------------------------------- 56 REAL(wp), DIMENSION(jpi,jpj), INTENT( inout ) :: ptab ! Field on which the diffusion is applied 57 ! 58 INTEGER :: ji, jj ! dummy loop indices 57 INTEGER :: jpl, nlay_i, isize, ihdf_vars 58 REAL(wp), DIMENSION(:,:,:), INTENT( inout ),TARGET :: ptab ! Field on which the diffusion is applied 59 ! 60 INTEGER :: ji, jj, jk, jl , jm ! dummy loop indices 59 61 INTEGER :: iter, ierr ! local integers 60 REAL(wp) :: zrlxint, zconv ! local scalars 61 REAL(wp), POINTER, DIMENSION(:,:) :: zrlx, zflu, zflv, zdiv0, zdiv, ztab0 62 REAL(wp) :: zrlxint ! local scalars 63 REAL(wp), POINTER , DIMENSION ( : ) :: zconv ! local scalars 64 REAL(wp), POINTER , DIMENSION(:,:,:) :: zrlx,zdiv0, ztab0 65 REAL(wp), POINTER , DIMENSION(:,:) :: zflu, zflv, zdiv 62 66 CHARACTER(lc) :: charout ! local character 63 67 REAL(wp), PARAMETER :: zrelax = 0.5_wp ! relaxation constant for iterative procedure … … 65 69 INTEGER , PARAMETER :: its = 100 ! Maximum number of iteration 66 70 !!------------------------------------------------------------------- 71 TYPE(arrayptr) , ALLOCATABLE, DIMENSION(:) :: pt2d_array, zrlx_array 72 CHARACTER(len=1) , ALLOCATABLE, DIMENSION(:) :: type_array ! define the nature of ptab array grid-points 73 ! ! = T , U , V , F , W and I points 74 REAL(wp) , ALLOCATABLE, DIMENSION(:) :: psgn_array ! =-1 the sign change across the north fold boundary 75 76 !!--------------------------------------------------------------------- 77 78 ! !== Initialisation ==! 79 ! +1 open water diffusion 80 isize = jpl*(ihdf_vars+nlay_i)+1 81 ALLOCATE( zconv (isize) ) 82 ALLOCATE( pt2d_array(isize) , zrlx_array(isize) ) 83 ALLOCATE( type_array(isize) ) 84 ALLOCATE( psgn_array(isize) ) 67 85 68 CALL wrk_alloc( jpi, jpj, zrlx, zflu, zflv, zdiv0, zdiv, ztab0 ) 69 70 ! !== Initialisation ==! 86 CALL wrk_alloc( jpi, jpj, isize, zrlx, zdiv0, ztab0 ) 87 CALL wrk_alloc( jpi, jpj, zflu, zflv, zdiv ) 88 89 DO jk= 1 , isize 90 pt2d_array(jk)%pt2d=>ptab(:,:,jk) 91 zrlx_array(jk)%pt2d=>zrlx(:,:,jk) 92 type_array(jk)='T' 93 psgn_array(jk)=1. 94 END DO 95 71 96 ! 72 97 IF( linit ) THEN ! Metric coefficient (compute at the first call and saved in efact) … … 74 99 IF( lk_mpp ) CALL mpp_sum( ierr ) 75 100 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'lim_hdf : unable to allocate arrays' ) 76 DO jj = 2, jpjm1 101 DO jj = 2, jpjm1 77 102 DO ji = fs_2 , fs_jpim1 ! vector opt. 78 103 efact(ji,jj) = ( e2u(ji,jj) + e2u(ji-1,jj) + e1v(ji,jj) + e1v(ji,jj-1) ) * r1_e12t(ji,jj) … … 83 108 ! ! Time integration parameters 84 109 ! 85 ztab0(:, : ) = ptab(:,:) ! Arrays initialization 86 zdiv0(:, 1 ) = 0._wp 87 zdiv0(:,jpj) = 0._wp 88 zflu (jpi,:) = 0._wp 89 zflv (jpi,:) = 0._wp 90 zdiv0(1, :) = 0._wp 91 zdiv0(jpi,:) = 0._wp 110 zflu (jpi,: ) = 0._wp 111 zflv (jpi,: ) = 0._wp 112 113 DO jk=1 , isize 114 ztab0(:, : , jk ) = ptab(:,:,jk) ! Arrays initialization 115 zdiv0(:, 1 , jk ) = 0._wp 116 zdiv0(:,jpj, jk ) = 0._wp 117 zdiv0(1, :, jk ) = 0._wp 118 zdiv0(jpi,:, jk ) = 0._wp 119 END DO 92 120 93 121 zconv = 1._wp !== horizontal diffusion using a Crant-Nicholson scheme ==! 94 122 iter = 0 95 123 ! 96 DO WHILE( zconv> ( 2._wp * 1.e-04 ) .AND. iter <= its ) ! Sub-time step loop124 DO WHILE( MAXVAL(zconv(:)) > ( 2._wp * 1.e-04 ) .AND. iter <= its ) ! Sub-time step loop 97 125 ! 98 126 iter = iter + 1 ! incrementation of the sub-time step number 99 127 ! 128 DO jk = 1 , isize 129 jl = (jk-1) /( ihdf_vars+nlay_i)+1 130 IF (zconv(jk) > ( 2._wp * 1.e-04 )) THEN 131 DO jj = 1, jpjm1 ! diffusive fluxes in U- and V- direction 132 DO ji = 1 , fs_jpim1 ! vector opt. 133 zflu(ji,jj) = pahu3D(ji,jj,jl) * e2u(ji,jj) * r1_e1u(ji,jj) * ( ptab(ji+1,jj,jk) - ptab(ji,jj,jk) ) 134 zflv(ji,jj) = pahv3D(ji,jj,jl) * e1v(ji,jj) * r1_e2v(ji,jj) * ( ptab(ji,jj+1,jk) - ptab(ji,jj,jk) ) 135 END DO 136 END DO 137 ! 138 DO jj= 2, jpjm1 ! diffusive trend : divergence of the fluxes 139 DO ji = fs_2 , fs_jpim1 ! vector opt. 140 zdiv(ji,jj) = ( zflu(ji,jj) - zflu(ji-1,jj) + zflv(ji,jj) - zflv(ji,jj-1) ) * r1_e12t(ji,jj) 141 END DO 142 END DO 143 ! 144 IF( iter == 1 ) zdiv0(:,:,jk) = zdiv(:,:) ! save the 1st evaluation of the diffusive trend in zdiv0 145 ! 146 DO jj = 2, jpjm1 ! iterative evaluation 147 DO ji = fs_2 , fs_jpim1 ! vector opt. 148 zrlxint = ( ztab0(ji,jj,jk) & 149 & + rdt_ice * ( zalfa * ( zdiv(ji,jj) + efact(ji,jj) * ptab(ji,jj,jk) ) & 150 & + ( 1.0 - zalfa ) * zdiv0(ji,jj,jk) ) & 151 & ) / ( 1.0 + zalfa * rdt_ice * efact(ji,jj) ) 152 zrlx(ji,jj,jk) = ptab(ji,jj,jk) + zrelax * ( zrlxint - ptab(ji,jj,jk) ) 153 END DO 154 END DO 155 END IF 156 157 END DO 158 159 CALL lbc_lnk_multi( zrlx_array, type_array , psgn_array , isize ) ! Multiple interchange of all the variables 160 ! 161 162 IF ( MOD( iter-1 , nn_convfrq ) == 0 ) THEN !Convergence test every nn_convfrq iterations (perf. optimization ) 163 DO jk=1,isize 164 zconv(jk) = 0._wp ! convergence test 165 DO jj = 2, jpjm1 166 DO ji = fs_2, fs_jpim1 167 zconv(jk) = MAX( zconv(jk), ABS( zrlx(ji,jj,jk) - ptab(ji,jj,jk) ) ) 168 END DO 169 END DO 170 END DO 171 IF( lk_mpp ) CALL mpp_max_multiple( zconv , isize ) ! max over the global domain for all the variables 172 ENDIF 173 ! 174 DO jk=1,isize 175 ptab(:,:,jk) = zrlx(:,:,jk) 176 END DO 177 ! 178 END DO ! end of sub-time step loop 179 180 ! ----------------------- 181 !!! final step (clem) !!! 182 DO jk = 1, isize 183 jl = (jk-1) /( ihdf_vars+nlay_i)+1 100 184 DO jj = 1, jpjm1 ! diffusive fluxes in U- and V- direction 101 185 DO ji = 1 , fs_jpim1 ! vector opt. 102 zflu(ji,jj) = pahu (ji,jj) * e2u(ji,jj) * r1_e1u(ji,jj) * ( ptab(ji+1,jj) - ptab(ji,jj) )103 zflv(ji,jj) = pahv (ji,jj) * e1v(ji,jj) * r1_e2v(ji,jj) * ( ptab(ji,jj+1) - ptab(ji,jj) )186 zflu(ji,jj) = pahu3D(ji,jj,jl) * e2u(ji,jj) * r1_e1u(ji,jj) * ( ptab(ji+1,jj,jk) - ptab(ji,jj,jk) ) 187 zflv(ji,jj) = pahv3D(ji,jj,jl) * e1v(ji,jj) * r1_e2v(ji,jj) * ( ptab(ji,jj+1,jk) - ptab(ji,jj,jk) ) 104 188 END DO 105 189 END DO … … 108 192 DO ji = fs_2 , fs_jpim1 ! vector opt. 109 193 zdiv(ji,jj) = ( zflu(ji,jj) - zflu(ji-1,jj) + zflv(ji,jj) - zflv(ji,jj-1) ) * r1_e12t(ji,jj) 110 END DO 111 END DO 112 ! 113 IF( iter == 1 ) zdiv0(:,:) = zdiv(:,:) ! save the 1st evaluation of the diffusive trend in zdiv0 114 ! 115 DO jj = 2, jpjm1 ! iterative evaluation 116 DO ji = fs_2 , fs_jpim1 ! vector opt. 117 zrlxint = ( ztab0(ji,jj) & 118 & + rdt_ice * ( zalfa * ( zdiv(ji,jj) + efact(ji,jj) * ptab(ji,jj) ) & 119 & + ( 1.0 - zalfa ) * zdiv0(ji,jj) ) & 120 & ) / ( 1.0 + zalfa * rdt_ice * efact(ji,jj) ) 121 zrlx(ji,jj) = ptab(ji,jj) + zrelax * ( zrlxint - ptab(ji,jj) ) 122 END DO 123 END DO 124 CALL lbc_lnk( zrlx, 'T', 1. ) ! lateral boundary condition 125 ! 126 IF ( MOD( iter, nn_convfrq ) == 0 ) THEN ! convergence test every nn_convfrq iterations (perf. optimization) 127 zconv = 0._wp 128 DO jj = 2, jpjm1 129 DO ji = fs_2, fs_jpim1 130 zconv = MAX( zconv, ABS( zrlx(ji,jj) - ptab(ji,jj) ) ) 131 END DO 132 END DO 133 IF( lk_mpp ) CALL mpp_max( zconv ) ! max over the global domain 134 ENDIF 135 ! 136 ptab(:,:) = zrlx(:,:) 137 ! 138 END DO ! end of sub-time step loop 139 140 ! ----------------------- 141 !!! final step (clem) !!! 142 DO jj = 1, jpjm1 ! diffusive fluxes in U- and V- direction 143 DO ji = 1 , fs_jpim1 ! vector opt. 144 zflu(ji,jj) = pahu(ji,jj) * e2u(ji,jj) * r1_e1u(ji,jj) * ( ptab(ji+1,jj) - ptab(ji,jj) ) 145 zflv(ji,jj) = pahv(ji,jj) * e1v(ji,jj) * r1_e2v(ji,jj) * ( ptab(ji,jj+1) - ptab(ji,jj) ) 194 ptab(ji,jj,jk) = ztab0(ji,jj,jk) + 0.5 * ( zdiv(ji,jj) + zdiv0(ji,jj,jk) ) 195 END DO 146 196 END DO 147 197 END DO 148 ! 149 DO jj= 2, jpjm1 ! diffusive trend : divergence of the fluxes 150 DO ji = fs_2 , fs_jpim1 ! vector opt. 151 zdiv(ji,jj) = ( zflu(ji,jj) - zflu(ji-1,jj) + zflv(ji,jj) - zflv(ji,jj-1) ) * r1_e12t(ji,jj) 152 ptab(ji,jj) = ztab0(ji,jj) + 0.5 * ( zdiv(ji,jj) + zdiv0(ji,jj) ) 153 END DO 154 END DO 155 CALL lbc_lnk( ptab, 'T', 1. ) ! lateral boundary condition 198 199 CALL lbc_lnk_multi( pt2d_array, type_array , psgn_array , isize ) ! Multiple interchange of all the variables 200 156 201 !!! final step (clem) !!! 157 202 ! ----------------------- 158 203 159 204 IF(ln_ctl) THEN 160 zrlx(:,:) = ptab(:,:) - ztab0(:,:) 161 WRITE(charout,FMT="(' lim_hdf : zconv =',D23.16, ' iter =',I4,2X)") zconv, iter 162 CALL prt_ctl( tab2d_1=zrlx, clinfo1=charout ) 163 ENDIF 164 ! 165 CALL wrk_dealloc( jpi, jpj, zrlx, zflu, zflv, zdiv0, zdiv, ztab0 ) 205 DO jk = 1 , isize 206 zrlx(:,:,jk) = ptab(:,:,jk) - ztab0(:,:,jk) 207 WRITE(charout,FMT="(' lim_hdf : zconv =',D23.16, ' iter =',I4,2X)") zconv, iter 208 CALL prt_ctl( tab2d_1=zrlx(:,:,jk), clinfo1=charout ) 209 END DO 210 ENDIF 211 ! 212 CALL wrk_dealloc( jpi, jpj, isize, zrlx, zdiv0, ztab0 ) 213 CALL wrk_dealloc( jpi, jpj, zflu, zflv, zdiv ) 214 215 DEALLOCATE( zconv ) 216 DEALLOCATE( pt2d_array , zrlx_array ) 217 DEALLOCATE( type_array ) 218 DEALLOCATE( psgn_array ) 166 219 ! 167 220 END SUBROUTINE lim_hdf 221 168 222 169 223 … … 179 233 !!------------------------------------------------------------------- 180 234 INTEGER :: ios ! Local integer output status for namelist read 181 NAMELIST/namicehdf/ nn_convfrq 235 NAMELIST/namicehdf/ nn_convfrq 182 236 !!------------------------------------------------------------------- 183 237 ! … … 212 266 !!====================================================================== 213 267 END MODULE limhdf 268 -
branches/UKMO/dev_r5518_GO6_missing_STABLE_revs/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90
r6795 r7965 24 24 USE par_oce ! ocean parameters 25 25 USE dom_ice ! sea-ice domain 26 USE limvar ! lim_var_salprof 26 27 USE in_out_manager ! I/O manager 27 28 USE lib_mpp ! MPP library … … 327 328 END DO 328 329 END DO 330 331 ! for constant salinity in time 332 IF( nn_icesal == 1 .OR. nn_icesal == 3 ) THEN 333 CALL lim_var_salprof 334 smv_i = sm_i * v_i 335 ENDIF 329 336 330 337 ! Snow temperature and heat content -
branches/UKMO/dev_r5518_GO6_missing_STABLE_revs/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90
r6498 r7965 651 651 wfx_dyn(ji,jj) = wfx_dyn(ji,jj) - vsw (ij) * rhoic * r1_rdtice ! increase in ice volume due to seawater frozen in voids 652 652 653 ! virtual salt flux to keep salinity constant 654 IF( nn_icesal == 1 .OR. nn_icesal == 3 ) THEN 655 srdg2(ij) = srdg2(ij) - vsw(ij) * ( sss_m(ji,jj) - sm_i(ji,jj,jl1) ) ! ridge salinity = sm_i 656 sfx_bri(ji,jj) = sfx_bri(ji,jj) + sss_m(ji,jj) * vsw(ij) * rhoic * r1_rdtice & ! put back sss_m into the ocean 657 & - sm_i(ji,jj,jl1) * vsw(ij) * rhoic * r1_rdtice ! and get sm_i from the ocean 658 ENDIF 659 653 660 !------------------------------------------ 654 661 ! 3.7 Put the snow somewhere in the ocean … … 664 671 hfx_dyn(ji,jj) = hfx_dyn(ji,jj) + ( - esrdg(ij) * ( 1._wp - rn_fsnowrdg ) & 665 672 & - esrft(ij) * ( 1._wp - rn_fsnowrft ) ) * r1_rdtice ! heat sink for ocean (<0, W.m-2) 666 673 667 674 !----------------------------------------------------------------- 668 675 ! 3.8 Compute quantities used to apportion ice among categories -
branches/UKMO/dev_r5518_GO6_missing_STABLE_revs/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90
r6498 r7965 116 116 117 117 ! Discriminate between varying salinity (nn_icesal=2) and prescribed cases (other values) 118 SELECT CASE( nn_icesal ) 119 CASE( 1, 3 , 4) ; zswitch_sal = 0 ! prescribed salinity profile120 CASE( 2 ) 118 SELECT CASE( nn_icesal ) ! varying salinity or not 119 CASE( 1, 3 ) ; zswitch_sal = 0 ! prescribed salinity profile 120 CASE( 2 ) ; zswitch_sal = 1 ! varying salinity profile 121 121 END SELECT 122 122 … … 651 651 652 652 ! Contribution to energy flux to the ocean [J/m2], >0 (if sst<0) 653 ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1654 653 zfmdt = ( rhosn - rhoic ) * MAX( dh_snowice(ji), 0._wp ) ! <0 655 654 zsstK = sst_m(ii,ij) + rt0 … … 662 661 ! Contribution to salt flux 663 662 sfx_sni_1d(ji) = sfx_sni_1d(ji) + sss_m(ii,ij) * a_i_1d(ji) * zfmdt * r1_rdtice 663 664 ! virtual salt flux to keep salinity constant 665 IF( nn_icesal == 1 .OR. nn_icesal == 3 ) THEN 666 sfx_bri_1d(ji) = sfx_bri_1d(ji) - sss_m(ii,ij) * a_i_1d(ji) * zfmdt * r1_rdtice & ! put back sss_m into the ocean 667 & - sm_i_1d(ji) * a_i_1d(ji) * dh_snowice(ji) * rhoic * r1_rdtice ! and get sm_i from the ocean 668 ENDIF 664 669 665 670 ! Contribution to mass flux -
branches/UKMO/dev_r5518_GO6_missing_STABLE_revs/NEMOGCM/NEMO/LIM_SRC_3/limthd_sal.F90
r6486 r7965 62 62 END DO 63 63 64 !------------------------------------------------------------------------------| 65 ! 1) Constant salinity, constant in time | 66 !------------------------------------------------------------------------------| 67 !!gm comment: if nn_icesal = 1 s_i_new, s_i_1d and sm_i_1d can be set to rn_icesal one for all in the initialisation phase !! 68 !!gm ===>>> simplification of almost all test on nn_icesal value 69 IF( nn_icesal == 1 ) THEN 70 s_i_1d (kideb:kiut,1:nlay_i) = rn_icesal 71 sm_i_1d(kideb:kiut) = rn_icesal 72 s_i_new(kideb:kiut) = rn_icesal 73 ENDIF 64 !--------------------------------------------------------------------| 65 ! 1) salinity constant in time | 66 !--------------------------------------------------------------------| 67 ! do nothing 74 68 75 !---------------------------------------------------------------------- --------|76 ! Module 2 : Constant salinity varying in time|77 !---------------------------------------------------------------------- --------|69 !----------------------------------------------------------------------| 70 ! 2) salinity varying in time | 71 !----------------------------------------------------------------------| 78 72 IF( nn_icesal == 2 ) THEN 79 73 … … 113 107 114 108 !------------------------------------------------------------------------------| 115 ! Module 3 : Profile of salinity, constant in time|109 ! 3) vertical profile of salinity, constant in time | 116 110 !------------------------------------------------------------------------------| 117 111 IF( nn_icesal == 3 ) CALL lim_var_salprof1d( kideb, kiut ) -
branches/UKMO/dev_r5518_GO6_missing_STABLE_revs/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90
r6498 r7965 63 63 INTEGER, INTENT(in) :: kt ! number of iteration 64 64 ! 65 INTEGER :: ji, jj, jk, j l, jt ! dummy loop indices65 INTEGER :: ji, jj, jk, jm , jl, jt ! dummy loop indices 66 66 INTEGER :: initad ! number of sub-timestep for the advection 67 67 REAL(wp) :: zcfl , zusnit ! - - … … 75 75 REAL(wp), POINTER, DIMENSION(:,:,:) :: zhimax ! old ice thickness 76 76 REAL(wp), POINTER, DIMENSION(:,:) :: zatold, zeiold, zesold ! old concentration, enthalpies 77 REAL(wp), POINTER, DIMENSION(:,:,:) :: zhdfptab 77 78 REAL(wp) :: zdv, zvi, zvs, zsmv, zes, zei 78 79 REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 80 !!--------------------------------------------------------------------- 81 INTEGER :: ihdf_vars = 6 !!Number of variables in which we apply horizontal diffusion 82 !! inside limtrp for each ice category , not counting the 83 !! variables corresponding to ice_layers 79 84 !!--------------------------------------------------------------------- 80 85 IF( nn_timing == 1 ) CALL timing_start('limtrp') … … 85 90 CALL wrk_alloc( jpi,jpj,nlay_i,jpl, z0ei ) 86 91 CALL wrk_alloc( jpi,jpj,jpl, zhimax, zviold, zvsold, zsmvold ) 92 CALL wrk_alloc( jpi,jpj,jpl*(ihdf_vars + nlay_i)+1,zhdfptab) 87 93 88 94 IF( numit == nstart .AND. lwp ) THEN … … 170 176 z0oi (:,:,jl) = oa_i (:,:,jl) * e12t(:,:) ! Age content 171 177 z0es (:,:,jl) = e_s (:,:,1,jl) * e12t(:,:) ! Snow heat content 172 178 DO jk = 1, nlay_i 173 179 z0ei (:,:,jk,jl) = e_i (:,:,jk,jl) * e12t(:,:) ! Ice heat content 174 180 END DO … … 284 290 ! Diffusion of Ice fields 285 291 !------------------------------------------------------------------------------! 286 292 !------------------------------------ 293 ! Diffusion of other ice variables 294 !------------------------------------ 295 jm=1 296 DO jl = 1, jpl 297 ! ! Masked eddy diffusivity coefficient at ocean U- and V-points 298 ! DO jj = 1, jpjm1 ! NB: has not to be defined on jpj line and jpi row 299 ! DO ji = 1 , fs_jpim1 ! vector opt. 300 ! pahu(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji ,jj,jl) ) ) ) & 301 ! & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji+1,jj,jl) ) ) ) * ahiu(ji,jj) 302 ! pahv(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji,jj ,jl) ) ) ) & 303 ! & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- a_i(ji,jj+1,jl) ) ) ) * ahiv(ji,jj) 304 ! END DO 305 ! END DO 306 DO jj = 1, jpjm1 ! NB: has not to be defined on jpj line and jpi row 307 DO ji = 1 , fs_jpim1 ! vector opt. 308 pahu3D(ji,jj,jl) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji ,jj, jl ) ) ) ) & 309 & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji+1,jj, jl ) ) ) ) * ahiu(ji,jj) 310 pahv3D(ji,jj,jl) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji, jj, jl ) ) ) ) & 311 & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- a_i(ji, jj+1,jl ) ) ) ) * ahiv(ji,jj) 312 END DO 313 END DO 314 315 zhdfptab(:,:,jm)= a_i (:,:, jl); jm = jm + 1 316 zhdfptab(:,:,jm)= v_i (:,:, jl); jm = jm + 1 317 zhdfptab(:,:,jm)= v_s (:,:, jl); jm = jm + 1 318 zhdfptab(:,:,jm)= smv_i(:,:, jl); jm = jm + 1 319 zhdfptab(:,:,jm)= oa_i (:,:, jl); jm = jm + 1 320 zhdfptab(:,:,jm)= e_s (:,:,1,jl); jm = jm + 1 321 ! Sample of adding more variables to apply lim_hdf using lim_hdf optimization--- 322 ! zhdfptab(:,:,jm) = variable_1 (:,:,1,jl); jm = jm + 1 323 ! zhdfptab(:,:,jm) = variable_2 (:,:,1,jl); jm = jm + 1 324 ! 325 ! and in this example the parameter ihdf_vars musb be changed to 8 (necessary for allocation) 326 !---------------------------------------------------------------------------------------- 327 DO jk = 1, nlay_i 328 zhdfptab(:,:,jm)=e_i(:,:,jk,jl); jm= jm+1 329 END DO 330 END DO 287 331 ! 288 332 !-------------------------------- … … 290 334 !-------------------------------- 291 335 ! ! Masked eddy diffusivity coefficient at ocean U- and V-points 336 !DO jj = 1, jpjm1 ! NB: has not to be defined on jpj line and jpi row 337 ! DO ji = 1 , fs_jpim1 ! vector opt. 338 ! pahu(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji ,jj) ) ) ) & 339 ! & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji+1,jj) ) ) ) * ahiu(ji,jj) 340 ! pahv(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji,jj ) ) ) ) & 341 ! & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- at_i(ji,jj+1) ) ) ) * ahiv(ji,jj) 342 ! END DO 343 !END DO 344 292 345 DO jj = 1, jpjm1 ! NB: has not to be defined on jpj line and jpi row 293 346 DO ji = 1 , fs_jpim1 ! vector opt. 294 pahu (ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji ,jj) ) ) ) &295 & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji+1,jj) ) ) ) * ahiu(ji,jj)296 pahv (ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji,jj ) ) ) ) &297 & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- at_i(ji,jj+1) ) ) ) * ahiv(ji,jj)347 pahu3D(ji,jj,jpl+1) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji ,jj) ) ) ) & 348 & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji+1,jj) ) ) ) * ahiu(ji,jj) 349 pahv3D(ji,jj,jpl+1) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji,jj ) ) ) ) & 350 & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- at_i(ji,jj+1) ) ) ) * ahiv(ji,jj) 298 351 END DO 299 352 END DO 300 353 ! 301 CALL lim_hdf( ato_i (:,:) ) 302 303 !------------------------------------ 304 ! Diffusion of other ice variables 305 !------------------------------------ 306 DO jl = 1, jpl 307 ! ! Masked eddy diffusivity coefficient at ocean U- and V-points 308 DO jj = 1, jpjm1 ! NB: has not to be defined on jpj line and jpi row 309 DO ji = 1 , fs_jpim1 ! vector opt. 310 pahu(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji ,jj,jl) ) ) ) & 311 & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji+1,jj,jl) ) ) ) * ahiu(ji,jj) 312 pahv(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji,jj ,jl) ) ) ) & 313 & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- a_i(ji,jj+1,jl) ) ) ) * ahiv(ji,jj) 314 END DO 315 END DO 316 317 CALL lim_hdf( v_i (:,:, jl) ) 318 CALL lim_hdf( v_s (:,:, jl) ) 319 CALL lim_hdf( smv_i(:,:, jl) ) 320 CALL lim_hdf( oa_i (:,:, jl) ) 321 CALL lim_hdf( a_i (:,:, jl) ) 322 CALL lim_hdf( e_s (:,:,1,jl) ) 354 zhdfptab(:,:,jm)= ato_i (:,:); 355 CALL lim_hdf( zhdfptab, ihdf_vars, jpl, nlay_i) 356 357 jm=1 358 DO jl = 1, jpl 359 a_i (:,:, jl) = zhdfptab(:,:,jm); jm = jm + 1 360 v_i (:,:, jl) = zhdfptab(:,:,jm); jm = jm + 1 361 v_s (:,:, jl) = zhdfptab(:,:,jm); jm = jm + 1 362 smv_i(:,:, jl) = zhdfptab(:,:,jm); jm = jm + 1 363 oa_i (:,:, jl) = zhdfptab(:,:,jm); jm = jm + 1 364 e_s (:,:,1,jl) = zhdfptab(:,:,jm); jm = jm + 1 365 ! Sample of adding more variables to apply lim_hdf--------- 366 ! variable_1 (:,:,1,jl) = zhdfptab(:,:, jm ) ; jm + 1 367 ! variable_2 (:,:,1,jl) = zhdfptab(:,:, jm ) ; jm + 1 368 !----------------------------------------------------------- 323 369 DO jk = 1, nlay_i 324 CALL lim_hdf( e_i(:,:,jk,jl) ) 325 END DO 326 END DO 370 e_i(:,:,jk,jl) = zhdfptab(:,:,jm);jm= jm + 1 371 END DO 372 END DO 373 374 ato_i (:,:) = zhdfptab(:,:,jm) 327 375 328 376 !------------------------------------------------------------------------------! … … 464 512 CALL wrk_dealloc( jpi,jpj,nlay_i,jpl, z0ei ) 465 513 CALL wrk_dealloc( jpi,jpj,jpl, zviold, zvsold, zhimax, zsmvold ) 514 CALL wrk_dealloc( jpi,jpj,jpl*(ihdf_vars+nlay_i)+1,zhdfptab) 466 515 ! 467 516 IF( nn_timing == 1 ) CALL timing_stop('limtrp') … … 479 528 !!====================================================================== 480 529 END MODULE limtrp 530 -
branches/UKMO/dev_r5518_GO6_missing_STABLE_revs/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90
r6498 r7965 314 314 ! Vertically constant, constant in time 315 315 !--------------------------------------- 316 IF( nn_icesal == 1 ) s_i(:,:,:,:) = rn_icesal 316 IF( nn_icesal == 1 ) THEN 317 s_i (:,:,:,:) = rn_icesal 318 sm_i(:,:,:) = rn_icesal 319 ENDIF 317 320 318 321 !----------------------------------- -
branches/UKMO/dev_r5518_GO6_missing_STABLE_revs/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90
r6486 r7965 11 11 !! the BDY/OBC communications 12 12 !! 3.4 ! 2012-12 (R. Bourdalle-Badie and G. Reffray) add a C1D case 13 !! 3.6 ! 2015-06 (O. Tintó and M. Castrillo) add lbc_lnk_multi 13 14 !!---------------------------------------------------------------------- 14 15 #if defined key_mpp_mpi … … 24 25 25 26 INTERFACE lbc_lnk_multi 26 MODULE PROCEDURE mpp_lnk_2d_9 27 MODULE PROCEDURE mpp_lnk_2d_9, mpp_lnk_2d_multiple 27 28 END INTERFACE 28 29 … … 80 81 END INTERFACE 81 82 83 INTERFACE lbc_lnk_multi 84 MODULE PROCEDURE lbc_lnk_2d_9, lbc_lnk_2d_multiple 85 END INTERFACE 86 82 87 INTERFACE lbc_bdy_lnk 83 88 MODULE PROCEDURE lbc_bdy_lnk_2d, lbc_bdy_lnk_3d … … 87 92 MODULE PROCEDURE lbc_lnk_2d_e 88 93 END INTERFACE 94 95 TYPE arrayptr 96 REAL , DIMENSION (:,:), POINTER :: pt2d 97 END TYPE arrayptr 98 PUBLIC arrayptr 89 99 90 100 PUBLIC lbc_lnk ! ocean/ice lateral boundary conditions 91 101 PUBLIC lbc_lnk_e 102 PUBLIC lbc_lnk_multi ! modified ocean lateral boundary conditions 92 103 PUBLIC lbc_bdy_lnk ! ocean lateral BDY boundary conditions 93 104 PUBLIC lbc_lnk_icb … … 171 182 ! 172 183 END SUBROUTINE lbc_lnk_2d 184 185 SUBROUTINE lbc_lnk_2d_multiple( pt2d_array , type_array , psgn_array , num_fields ) 186 !! 187 INTEGER :: num_fields 188 TYPE( arrayptr ), DIMENSION(:) :: pt2d_array 189 CHARACTER(len=1), DIMENSION(:), INTENT(in ) :: type_array ! define the nature of ptab array grid-points 190 ! ! = T , U , V , F , W and I points 191 REAL(wp) , DIMENSION(:), INTENT(in ) :: psgn_array ! =-1 the sign change across the north fold boundary 192 ! ! = 1. , the sign is kept 193 ! 194 INTEGER :: ii !!MULTI SEND DUMMY LOOP INDICES 195 ! 196 DO ii = 1, num_fields 197 CALL lbc_lnk_2d( pt2d_array(ii)%pt2d, type_array(ii), psgn_array(ii) ) 198 END DO 199 ! 200 END SUBROUTINE lbc_lnk_2d_multiple 201 202 SUBROUTINE lbc_lnk_2d_9( pt2dA, cd_typeA, psgnA, pt2dB, cd_typeB, psgnB, pt2dC, cd_typeC, psgnC & 203 & , pt2dD, cd_typeD, psgnD, pt2dE, cd_typeE, psgnE, pt2dF, cd_typeF, psgnF & 204 & , pt2dG, cd_typeG, psgnG, pt2dH, cd_typeH, psgnH, pt2dI, cd_typeI, psgnI, cd_mpp, pval) 205 !!--------------------------------------------------------------------- 206 ! Second 2D array on which the boundary condition is applied 207 REAL(wp), DIMENSION(jpi,jpj), TARGET , INTENT(inout) :: pt2dA 208 REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) :: pt2dB , pt2dC , pt2dD , pt2dE 209 REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) :: pt2dF , pt2dG , pt2dH , pt2dI 210 ! define the nature of ptab array grid-points 211 CHARACTER(len=1) , INTENT(in ) :: cd_typeA 212 CHARACTER(len=1) , OPTIONAL, INTENT(in ) :: cd_typeB , cd_typeC , cd_typeD , cd_typeE 213 CHARACTER(len=1) , OPTIONAL, INTENT(in ) :: cd_typeF , cd_typeG , cd_typeH , cd_typeI 214 ! =-1 the sign change across the north fold boundary 215 REAL(wp) , INTENT(in ) :: psgnA 216 REAL(wp) , OPTIONAL, INTENT(in ) :: psgnB , psgnC , psgnD , psgnE 217 REAL(wp) , OPTIONAL, INTENT(in ) :: psgnF , psgnG , psgnH , psgnI 218 CHARACTER(len=3) , OPTIONAL, INTENT(in ) :: cd_mpp ! fill the overlap area only 219 REAL(wp) , OPTIONAL, INTENT(in ) :: pval ! background value (used at closed boundaries) 220 !! 221 !!--------------------------------------------------------------------- 222 223 !!The first array 224 CALL lbc_lnk( pt2dA, cd_typeA, psgnA ) 225 226 !! Look if more arrays to process 227 IF(PRESENT (psgnB) )CALL lbc_lnk( pt2dA, cd_typeA, psgnA ) 228 IF(PRESENT (psgnC) )CALL lbc_lnk( pt2dC, cd_typeC, psgnC ) 229 IF(PRESENT (psgnD) )CALL lbc_lnk( pt2dD, cd_typeD, psgnD ) 230 IF(PRESENT (psgnE) )CALL lbc_lnk( pt2dE, cd_typeE, psgnE ) 231 IF(PRESENT (psgnF) )CALL lbc_lnk( pt2dF, cd_typeF, psgnF ) 232 IF(PRESENT (psgnG) )CALL lbc_lnk( pt2dG, cd_typeG, psgnG ) 233 IF(PRESENT (psgnH) )CALL lbc_lnk( pt2dH, cd_typeH, psgnH ) 234 IF(PRESENT (psgnI) )CALL lbc_lnk( pt2dI, cd_typeI, psgnI ) 235 236 END SUBROUTINE lbc_lnk_2d_9 237 238 239 240 173 241 174 242 #else … … 372 440 ! 373 441 END SUBROUTINE lbc_lnk_2d 442 443 SUBROUTINE lbc_lnk_2d_multiple( pt2d_array , type_array , psgn_array , num_fields ) 444 !! 445 INTEGER :: num_fields 446 TYPE( arrayptr ), DIMENSION(:) :: pt2d_array 447 CHARACTER(len=1), DIMENSION(:), INTENT(in ) :: type_array ! define the nature of ptab array grid-points 448 ! ! = T , U , V , F , W and I points 449 REAL(wp) , DIMENSION(:), INTENT(in ) :: psgn_array ! =-1 the sign change across the north fold boundary 450 ! ! = 1. , the sign is kept 451 ! 452 INTEGER :: ii !!MULTI SEND DUMMY LOOP INDICES 453 ! 454 DO ii = 1, num_fields 455 CALL lbc_lnk_2d( pt2d_array(ii)%pt2d, type_array(ii), psgn_array(ii) ) 456 END DO 457 ! 458 END SUBROUTINE lbc_lnk_2d_multiple 459 460 SUBROUTINE lbc_lnk_2d_9( pt2dA, cd_typeA, psgnA, pt2dB, cd_typeB, psgnB, pt2dC, cd_typeC, psgnC & 461 & , pt2dD, cd_typeD, psgnD, pt2dE, cd_typeE, psgnE, pt2dF, cd_typeF, psgnF & 462 & , pt2dG, cd_typeG, psgnG, pt2dH, cd_typeH, psgnH, pt2dI, cd_typeI, psgnI, cd_mpp, pval) 463 !!--------------------------------------------------------------------- 464 ! Second 2D array on which the boundary condition is applied 465 REAL(wp), DIMENSION(jpi,jpj), TARGET , INTENT(inout) :: pt2dA 466 REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) :: pt2dB , pt2dC , pt2dD , pt2dE 467 REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) :: pt2dF , pt2dG , pt2dH , pt2dI 468 ! define the nature of ptab array grid-points 469 CHARACTER(len=1) , INTENT(in ) :: cd_typeA 470 CHARACTER(len=1) , OPTIONAL, INTENT(in ) :: cd_typeB , cd_typeC , cd_typeD , cd_typeE 471 CHARACTER(len=1) , OPTIONAL, INTENT(in ) :: cd_typeF , cd_typeG , cd_typeH , cd_typeI 472 ! =-1 the sign change across the north fold boundary 473 REAL(wp) , INTENT(in ) :: psgnA 474 REAL(wp) , OPTIONAL, INTENT(in ) :: psgnB , psgnC , psgnD , psgnE 475 REAL(wp) , OPTIONAL, INTENT(in ) :: psgnF , psgnG , psgnH , psgnI 476 CHARACTER(len=3) , OPTIONAL, INTENT(in ) :: cd_mpp ! fill the overlap area only 477 REAL(wp) , OPTIONAL, INTENT(in ) :: pval ! background value (used at closed boundaries) 478 !! 479 !!--------------------------------------------------------------------- 480 481 !!The first array 482 CALL lbc_lnk( pt2dA, cd_typeA, psgnA ) 483 484 !! Look if more arrays to process 485 IF(PRESENT (psgnB) )CALL lbc_lnk( pt2dA, cd_typeA, psgnA ) 486 IF(PRESENT (psgnC) )CALL lbc_lnk( pt2dC, cd_typeC, psgnC ) 487 IF(PRESENT (psgnD) )CALL lbc_lnk( pt2dD, cd_typeD, psgnD ) 488 IF(PRESENT (psgnE) )CALL lbc_lnk( pt2dE, cd_typeE, psgnE ) 489 IF(PRESENT (psgnF) )CALL lbc_lnk( pt2dF, cd_typeF, psgnF ) 490 IF(PRESENT (psgnG) )CALL lbc_lnk( pt2dG, cd_typeG, psgnG ) 491 IF(PRESENT (psgnH) )CALL lbc_lnk( pt2dH, cd_typeH, psgnH ) 492 IF(PRESENT (psgnI) )CALL lbc_lnk( pt2dI, cd_typeI, psgnI ) 493 494 END SUBROUTINE lbc_lnk_2d_9 495 374 496 375 497 #endif … … 441 563 !!====================================================================== 442 564 END MODULE lbclnk 565 -
branches/UKMO/dev_r5518_GO6_missing_STABLE_revs/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
r6487 r7965 24 24 !! 3.5 ! 2013 ( C. Ethe, G. Madec ) message passing arrays as local variables 25 25 !! 3.5 ! 2013 (S.Mocavero, I.Epicoco - CMCC) north fold optimizations 26 !! 3.6 ! 2015 (O. Tintó and M. Castrillo - BSC) Added 'mpp_lnk_2d_multiple', 'mpp_lbc_north_2d_multiple', 'mpp_max_multiple' 26 27 !!---------------------------------------------------------------------- 27 28 … … 62 63 USE lbcnfd ! north fold treatment 63 64 USE in_out_manager ! I/O manager 65 USE wrk_nemo ! work arrays 64 66 65 67 IMPLICIT NONE … … 70 72 PUBLIC mpp_ini_north, mpp_lbc_north, mpp_lbc_north_e 71 73 PUBLIC mpp_min, mpp_max, mpp_sum, mpp_minloc, mpp_maxloc 74 PUBLIC mpp_max_multiple 72 75 PUBLIC mpp_lnk_3d, mpp_lnk_3d_gather, mpp_lnk_2d, mpp_lnk_2d_e 73 PUBLIC mpp_lnk_2d_9 76 PUBLIC mpp_lnk_2d_9 , mpp_lnk_2d_multiple 74 77 PUBLIC mppscatter, mppgather 75 78 PUBLIC mpp_ini_ice, mpp_ini_znl … … 78 81 PUBLIC mpp_lnk_bdy_2d, mpp_lnk_bdy_3d 79 82 PUBLIC mpp_lbc_north_icb, mpp_lnk_2d_icb 83 PUBLIC mpprank 80 84 81 85 TYPE arrayptr 82 86 REAL , DIMENSION (:,:), POINTER :: pt2d 83 87 END TYPE arrayptr 88 PUBLIC arrayptr 84 89 85 90 !! * Interfaces … … 105 110 INTERFACE mpp_maxloc 106 111 MODULE PROCEDURE mpp_maxloc2d ,mpp_maxloc3d 112 END INTERFACE 113 114 INTERFACE mpp_max_multiple 115 MODULE PROCEDURE mppmax_real_multiple 107 116 END INTERFACE 108 117 … … 732 741 ! ----------------------- 733 742 ! 734 DO ii = 1 , num_fields735 743 !First Array 736 IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN 737 ! 738 SELECT CASE ( jpni ) 739 CASE ( 1 ) ; CALL lbc_nfd ( pt2d_array(ii)%pt2d( : , : ), type_array(ii) , psgn_array(ii) ) ! only 1 northern proc, no mpp 740 CASE DEFAULT ; CALL mpp_lbc_north( pt2d_array(ii)%pt2d( : , : ), type_array(ii), psgn_array(ii) ) ! for all northern procs. 741 END SELECT 742 ! 743 ENDIF 744 ! 745 END DO 744 IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN 745 ! 746 SELECT CASE ( jpni ) 747 CASE ( 1 ) ; 748 DO ii = 1 , num_fields 749 CALL lbc_nfd ( pt2d_array(ii)%pt2d( : , : ), type_array(ii) , psgn_array(ii) ) ! only 1 northern proc, no mpp 750 END DO 751 CASE DEFAULT ; CALL mpp_lbc_north_2d_multiple( pt2d_array, type_array, psgn_array, num_fields ) ! for all northern procs. 752 END SELECT 753 ! 754 ENDIF 755 ! 746 756 747 757 DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we ) … … 1689 1699 END SUBROUTINE mppmax_real 1690 1700 1701 SUBROUTINE mppmax_real_multiple( ptab, NUM , kcom ) 1702 !!---------------------------------------------------------------------- 1703 !! *** routine mppmax_real *** 1704 !! 1705 !! ** Purpose : Maximum 1706 !! 1707 !!---------------------------------------------------------------------- 1708 REAL(wp), DIMENSION(:) , INTENT(inout) :: ptab ! ??? 1709 INTEGER , INTENT(in ) :: NUM 1710 INTEGER , INTENT(in ), OPTIONAL :: kcom ! ??? 1711 !! 1712 INTEGER :: ierror, localcomm 1713 REAL(wp) , POINTER , DIMENSION(:) :: zwork 1714 !!---------------------------------------------------------------------- 1715 ! 1716 CALL wrk_alloc(NUM , zwork) 1717 localcomm = mpi_comm_opa 1718 IF( PRESENT(kcom) ) localcomm = kcom 1719 ! 1720 CALL mpi_allreduce( ptab, zwork, NUM, mpi_double_precision, mpi_max, localcomm, ierror ) 1721 ptab = zwork 1722 CALL wrk_dealloc(NUM , zwork) 1723 ! 1724 END SUBROUTINE mppmax_real_multiple 1725 1691 1726 1692 1727 SUBROUTINE mppmin_a_real( ptab, kdim, kcom ) … … 2583 2618 END SUBROUTINE mpp_lbc_north_2d 2584 2619 2620 SUBROUTINE mpp_lbc_north_2d_multiple( pt2d_array, cd_type, psgn, num_fields) 2621 !!--------------------------------------------------------------------- 2622 !! *** routine mpp_lbc_north_2d *** 2623 !! 2624 !! ** Purpose : Ensure proper north fold horizontal bondary condition 2625 !! in mpp configuration in case of jpn1 > 1 2626 !! (for multiple 2d arrays ) 2627 !! 2628 !! ** Method : North fold condition and mpp with more than one proc 2629 !! in i-direction require a specific treatment. We gather 2630 !! the 4 northern lines of the global domain on 1 processor 2631 !! and apply lbc north-fold on this sub array. Then we 2632 !! scatter the north fold array back to the processors. 2633 !! 2634 !!---------------------------------------------------------------------- 2635 INTEGER , INTENT (in ) :: num_fields ! number of variables contained in pt2d 2636 TYPE( arrayptr ), DIMENSION(:) :: pt2d_array 2637 CHARACTER(len=1), DIMENSION(:), INTENT(in ) :: cd_type ! nature of pt2d grid-points 2638 ! ! = T , U , V , F or W gridpoints 2639 REAL(wp), DIMENSION(:), INTENT(in ) :: psgn ! = -1. the sign change across the north fold 2640 !! ! = 1. , the sign is kept 2641 INTEGER :: ji, jj, jr, jk 2642 INTEGER :: ierr, itaille, ildi, ilei, iilb 2643 INTEGER :: ijpj, ijpjm1, ij, iproc 2644 INTEGER, DIMENSION (jpmaxngh) :: ml_req_nf !for mpi_isend when avoiding mpi_allgather 2645 INTEGER :: ml_err ! for mpi_isend when avoiding mpi_allgather 2646 INTEGER, DIMENSION(MPI_STATUS_SIZE):: ml_stat ! for mpi_isend when avoiding mpi_allgather 2647 ! ! Workspace for message transfers avoiding mpi_allgather 2648 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE :: ztab 2649 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE :: znorthloc, zfoldwk 2650 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: znorthgloio 2651 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE :: ztabl, ztabr 2652 INTEGER :: istatus(mpi_status_size) 2653 INTEGER :: iflag 2654 !!---------------------------------------------------------------------- 2655 ! 2656 ALLOCATE( ztab(jpiglo,4,num_fields), znorthloc(jpi,4,num_fields), zfoldwk(jpi,4,num_fields), znorthgloio(jpi,4,num_fields,jpni) ) ! expanded to 3 dimensions 2657 ALLOCATE( ztabl(jpi,4,num_fields), ztabr(jpi*jpmaxngh, 4,num_fields) ) 2658 ! 2659 ijpj = 4 2660 ijpjm1 = 3 2661 ! 2662 2663 DO jk = 1, num_fields 2664 DO jj = nlcj-ijpj+1, nlcj ! put in znorthloc the last 4 jlines of pt2d (for every variable) 2665 ij = jj - nlcj + ijpj 2666 znorthloc(:,ij,jk) = pt2d_array(jk)%pt2d(:,jj) 2667 END DO 2668 END DO 2669 ! ! Build in procs of ncomm_north the znorthgloio 2670 itaille = jpi * ijpj 2671 2672 IF ( l_north_nogather ) THEN 2673 ! 2674 ! Avoid the use of mpi_allgather by exchanging only with the processes already identified 2675 ! (in nemo_northcomms) as being involved in this process' northern boundary exchange 2676 ! 2677 ztabr(:,:,:) = 0 2678 ztabl(:,:,:) = 0 2679 2680 DO jk = 1, num_fields 2681 DO jj = nlcj-ijpj+1, nlcj ! First put local values into the global array 2682 ij = jj - nlcj + ijpj 2683 DO ji = nfsloop, nfeloop 2684 ztabl(ji,ij,jk) = pt2d_array(jk)%pt2d(ji,jj) 2685 END DO 2686 END DO 2687 END DO 2688 2689 DO jr = 1,nsndto 2690 IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN 2691 CALL mppsend(5, znorthloc, itaille*num_fields, nfipproc(isendto(jr),jpnj), ml_req_nf(jr)) ! Buffer expanded "num_fields" times 2692 ENDIF 2693 END DO 2694 DO jr = 1,nsndto 2695 iproc = nfipproc(isendto(jr),jpnj) 2696 IF(iproc .ne. -1) THEN 2697 ilei = nleit (iproc+1) 2698 ildi = nldit (iproc+1) 2699 iilb = nfiimpp(isendto(jr),jpnj) - nfiimpp(isendto(1),jpnj) 2700 ENDIF 2701 IF((iproc .ne. (narea-1)) .and. (iproc .ne. -1)) THEN 2702 CALL mpprecv(5, zfoldwk, itaille*num_fields, iproc) ! Buffer expanded "num_fields" times 2703 DO jk = 1 , num_fields 2704 DO jj = 1, ijpj 2705 DO ji = ildi, ilei 2706 ztabr(iilb+ji,jj,jk) = zfoldwk(ji,jj,jk) ! Modified to 3D 2707 END DO 2708 END DO 2709 END DO 2710 ELSE IF (iproc .eq. (narea-1)) THEN 2711 DO jk = 1, num_fields 2712 DO jj = 1, ijpj 2713 DO ji = ildi, ilei 2714 ztabr(iilb+ji,jj,jk) = pt2d_array(jk)%pt2d(ji,nlcj-ijpj+jj) ! Modified to 3D 2715 END DO 2716 END DO 2717 END DO 2718 ENDIF 2719 END DO 2720 IF (l_isend) THEN 2721 DO jr = 1,nsndto 2722 IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN 2723 CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err) 2724 ENDIF 2725 END DO 2726 ENDIF 2727 ! 2728 DO ji = 1, num_fields ! Loop to manage 3D variables 2729 CALL mpp_lbc_nfd( ztabl(:,:,ji), ztabr(:,:,ji), cd_type(ji), psgn(ji) ) ! North fold boundary condition 2730 END DO 2731 ! 2732 DO jk = 1, num_fields 2733 DO jj = nlcj-ijpj+1, nlcj ! Scatter back to pt2d 2734 ij = jj - nlcj + ijpj 2735 DO ji = 1, nlci 2736 pt2d_array(jk)%pt2d(ji,jj) = ztabl(ji,ij,jk) ! Modified to 3D 2737 END DO 2738 END DO 2739 END DO 2740 2741 ! 2742 ELSE 2743 ! 2744 CALL MPI_ALLGATHER( znorthloc , itaille*num_fields, MPI_DOUBLE_PRECISION, & 2745 & znorthgloio, itaille*num_fields, MPI_DOUBLE_PRECISION, ncomm_north, ierr ) 2746 ! 2747 ztab(:,:,:) = 0.e0 2748 DO jk = 1, num_fields 2749 DO jr = 1, ndim_rank_north ! recover the global north array 2750 iproc = nrank_north(jr) + 1 2751 ildi = nldit (iproc) 2752 ilei = nleit (iproc) 2753 iilb = nimppt(iproc) 2754 DO jj = 1, ijpj 2755 DO ji = ildi, ilei 2756 ztab(ji+iilb-1,jj,jk) = znorthgloio(ji,jj,jk,jr) 2757 END DO 2758 END DO 2759 END DO 2760 END DO 2761 2762 DO ji = 1, num_fields 2763 CALL lbc_nfd( ztab(:,:,ji), cd_type(ji), psgn(ji) ) ! North fold boundary condition 2764 END DO 2765 ! 2766 DO jk = 1, num_fields 2767 DO jj = nlcj-ijpj+1, nlcj ! Scatter back to pt2d 2768 ij = jj - nlcj + ijpj 2769 DO ji = 1, nlci 2770 pt2d_array(jk)%pt2d(ji,jj) = ztab(ji+nimpp-1,ij,jk) 2771 END DO 2772 END DO 2773 END DO 2774 ! 2775 ! 2776 ENDIF 2777 DEALLOCATE( ztab, znorthloc, zfoldwk, znorthgloio ) 2778 DEALLOCATE( ztabl, ztabr ) 2779 ! 2780 END SUBROUTINE mpp_lbc_north_2d_multiple 2585 2781 2586 2782 SUBROUTINE mpp_lbc_north_e( pt2d, cd_type, psgn) -
branches/UKMO/dev_r5518_GO6_missing_STABLE_revs/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
r6498 r7965 340 340 emp_b(:,:) = emp(:,:) 341 341 sfx_b(:,:) = sfx(:,:) 342 IF ( ln_rnf ) THEN 343 rnf_b (:,: ) = rnf (:,: ) 344 rnf_tsc_b(:,:,:) = rnf_tsc(:,:,:) 345 ENDIF 342 346 ENDIF 343 347 ! ! ---------------------------------------- ! -
branches/UKMO/dev_r5518_GO6_missing_STABLE_revs/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90
r6498 r7965 109 109 ! 110 110 CALL wrk_alloc( jpi,jpj, ztfrz) 111 112 ! ! ---------------------------------------- ! 113 IF( kt /= nit000 ) THEN ! Swap of forcing fields ! 114 ! ! ---------------------------------------- ! 115 rnf_b (:,: ) = rnf (:,: ) ! Swap the ocean forcing fields except at nit000 116 rnf_tsc_b(:,:,:) = rnf_tsc(:,:,:) ! where before fields are set at the end of the routine 117 ! 118 ENDIF 119 111 ! 120 112 ! !-------------------! 121 113 ! ! Update runoff ! -
branches/UKMO/dev_r5518_GO6_missing_STABLE_revs/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90
r6793 r7965 279 279 END DO 280 280 ENDIF 281 281 282 IF( iom_use('rnf_x_sst') ) CALL iom_put( "rnf_x_sst", rnf*tsn(:,:,1,jp_tem) ) ! runoff term on sst 283 IF( iom_use('rnf_x_sss') ) CALL iom_put( "rnf_x_sss", rnf*tsn(:,:,1,jp_sal) ) ! runoff term on sss 284 282 285 IF( l_trdtra ) THEN ! send trends for further diagnostics 283 286 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) -
branches/UKMO/dev_r5518_GO6_missing_STABLE_revs/NEMOGCM/SETTE/sette.sh
r6487 r7965 123 123 # Directory to run the tests 124 124 SETTE_DIR=$(cd $(dirname "$0"); pwd) 125 MAIN_DIR=$ {SETTE_DIR%/SETTE}125 MAIN_DIR=$(dirname $SETTE_DIR) 126 126 CONFIG_DIR=${MAIN_DIR}/CONFIG 127 127 TOOLS_DIR=${MAIN_DIR}/TOOLS -
branches/UKMO/dev_r5518_GO6_missing_STABLE_revs/NEMOGCM/TOOLS/REBUILD_NEMO/icb_combrest.py
r6793 r7965 180 180 if "units" in invar.ncattrs(): 181 181 fo.variables[var].units = invar.units 182 182 os.remove(pathout.replace('.nc','_WORK.nc')) 183 183 # 184 184 add_k = 1 -
branches/UKMO/dev_r5518_GO6_missing_STABLE_revs/NEMOGCM/TOOLS/SIREN/README
r5037 r7965 1 This is a first release of SIREN.2 1 3 To create SIREN documentation, go to ./src and run doxygen2 To create SIREN documentation, run doxygen in TOOLS/SIREN directory 4 3 (http://www.stack.nl/~dimitri/doxygen/index.html version 1.8.3.1 or upper) 5 4 then 6 open . ./doc/index.html5 open ./TOOLS/SIREN/doc/html/index.html in your web browser 7 6 or 8 run ../doc/latex/gmake and open refman.pdf 9 10 11 templates of namelists could be find in templates directory. 12 read documentation for more information. 13 14 1- program to create coordinate file : 15 16 ./create_coord create_coord.nam 17 18 19 Variables are extracted from the input coordinates coarse grid and 20 interpolated to create fine coordinates files. 21 22 2- program to create bathymetry file: 23 24 ./create_bathy create_bathy.nam 25 26 Bathymetry could be extracted from fine grid Bathymetry file, or 27 interpolated from coarse grid Bathymetry file. 28 29 3- program to merge bathymetry file at boundaries : 30 31 ./merge_bathy merge_bathy.nam 32 33 Coarse grid Bathymetry is interpolated on fine grid. 34 Then fine Bathymetry and refined coarse bathymetry are merged at 35 boundaries. 36 37 4- program to create restart file : 38 39 ./create_restart create_restart.nam 40 41 Variables are read from restart file, or standard output. 42 Then theses variables are interpolated on fine grid. 43 Finally table are split over new decomposition. 44 45 5- program to create boundary files (OBC) : 46 47 ./create_boundary create_boundary.nam 48 49 Variables are read from standard output. 50 Then theses variables are interpolated on fine grid boundaries. 7 run ./TOOLS/SIREN/doc/latex/gmake and open ./TOOLS/SIREN/doc/latex/refman.pdf -
branches/UKMO/dev_r5518_GO6_missing_STABLE_revs/NEMOGCM/TOOLS/SIREN/src/docsrc/1_install.md
r6487 r7965 17 17 <!-- - pgf95 (version 13.9-0) --> 18 18 19 <HR> 20 <b> 21 - @ref index 22 - @ref md_docsrc_3_codingRules 23 - @ref md_docsrc_4_changeLog 24 - @ref todo 25 </b> 19 # Fortran Compiler # 20 SIREN codes were succesfully tested with : 21 - ifort (version 15.0.1) 22 - gfortran (version 4.8.2 20140120) 23 24 <HR> 25 <b> 26 - @ref index 27 - @ref md_src_docsrc_2_quickstart 28 - @ref md_src_docsrc_3_support_bug 29 - @ref md_src_docsrc_4_codingRules 30 - @ref md_src_docsrc_5_changeLog 31 - @ref todo 32 </b> -
branches/UKMO/dev_r5518_GO6_missing_STABLE_revs/NEMOGCM/TOOLS/SIREN/src/docsrc/main.dox
r5037 r7965 13 13 - create_boundary.f90 to create boundary condition from coarse grid standard outputs. 14 14 15 To install those programs see @ref md_docsrc_1_install. 15 SIREN is a software to set up regional configuration with [NEMO](http://www.nemo-ocean.eu).<br/> 16 Actually SIREN creates the input files you need to run a NEMO regional configuration.<br/> 17 18 SIREN allows you to create your own regional configuration embedded in a wider one.<br/> 16 19 17 @note SIREN can not: 18 - create global configuration 19 - create configuarion around or close to north pole 20 - change number of vertical level 21 - change grid (horizontal or vertical) 20 To know how to install SIREN see @ref md_src_docsrc_1_install. 22 21 23 @section howto How to use 24 @subsection howto_coord to create fine grid coordinate file 25 see create_coord.f90 26 @subsection howto_bathy to create fine grid bathymetry 27 see create_bathy.f90 28 @subsection howto_merge to merge fine grid bathymetry 29 see merge_bathy.f90 30 @subsection howto_restart to create initial state file 31 see create_restart.f90 32 @subsection howto_boundary to create boundary condition 33 see create_boundary.f90 22 You could find a tutorial for a quick start with SIREN in @ref md_src_docsrc_2_quickstart.<br/> 23 For more information about how to use each component of SIREN 24 - see create_coord.f90 to create fine grid coordinate file 25 - see create_bathy.f90 to create fine grid bathymetry 26 - see merge_bathy.f90 to merge fine grid bathymetry 27 - see create_restart.f90 to create initial state file, or other fields. 28 - see create_boundary.F90 to create boundary condition 34 29 35 30 <HR> 36 31 <b> 37 - @ref md_docsrc_1_install 38 - @ref md_docsrc_3_codingRules 39 - @ref md_docsrc_4_changeLog 32 - @ref md_src_docsrc_1_install 33 - @ref md_src_docsrc_2_quickstart 34 - @ref md_src_docsrc_3_support_bug 35 - @ref md_src_docsrc_4_codingRules 36 - @ref md_src_docsrc_5_changeLog 40 37 - @ref todo 41 38 </b>
Note: See TracChangeset
for help on using the changeset viewer.