New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 15122 – NEMO

Changeset 15122


Ignore:
Timestamp:
2021-07-15T11:11:28+02:00 (3 years ago)
Author:
ayoung
Message:

Merging bug fixes up to 15096. Ticket #2648.

Location:
NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src
Files:
57 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/OCE/DIA/diawri.F90

    r15080 r15122  
    160160      ENDIF 
    161161 
     162      ! initialize arrays 
     163      z2d(:,:)   = 0._wp 
     164      z3d(:,:,:) = 0._wp 
     165       
    162166      ! Output of initial vertical scale factor 
    163167      CALL iom_put("e3t_0", e3t_0(:,:,:) ) 
    … …  
    167171      ! 
    168172      IF ( iom_use("tpt_dep") ) THEN 
    169          DO jk = 1, jpk 
    170             z3d(:,:,jk) = gdept(:,:,jk,Kmm) 
    171          END DO 
     173         DO_3D( 0, 0, 0, 0, 1, jpk ) 
     174            z3d(ji,jj,jk) = gdept(ji,jj,jk,Kmm) 
     175         END_3D 
    172176         CALL iom_put( "tpt_dep", z3d ) 
    173177      ENDIF 
    174178 
     179      ! --- vertical scale factors --- ! 
    175180      IF ( iom_use("e3t") .OR. iom_use("e3tdef") ) THEN  ! time-varying e3t 
    176          DO jk = 1, jpk 
    177             z3d(:,:,jk) =  e3t(:,:,jk,Kmm) 
    178          END DO 
     181         DO_3D( 0, 0, 0, 0, 1, jpk ) 
     182            z3d(ji,jj,jk) =  e3t(ji,jj,jk,Kmm) 
     183         END_3D 
    179184         CALL iom_put( "e3t", z3d ) 
    180185         IF ( iom_use("e3tdef") ) THEN 
    181             z3d(:,:,:) = ( ( z3d(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100._wp * tmask(:,:,:) ) ** 2  
     186            DO_3D( 0, 0, 0, 0, 1, jpk ) 
     187               z3d(ji,jj,jk) = ( ( z3d(ji,jj,jk) - e3t_0(ji,jj,jk) ) / e3t_0(ji,jj,jk) * 100._wp * tmask(ji,jj,jk) ) ** 2 
     188            END_3D 
    182189            CALL iom_put( "e3tdef", z3d )  
    183190         ENDIF 
    184191      ENDIF  
    185192      IF ( iom_use("e3u") ) THEN                         ! time-varying e3u 
    186          DO jk = 1, jpk 
    187             z3d(:,:,jk) =  e3u(:,:,jk,Kmm) 
    188          END DO  
     193         DO_3D( 0, 0, 0, 0, 1, jpk ) 
     194            z3d(ji,jj,jk) =  e3u(ji,jj,jk,Kmm) 
     195         END_3D  
    189196         CALL iom_put( "e3u" , z3d ) 
    190197      ENDIF 
    191198      IF ( iom_use("e3v") ) THEN                         ! time-varying e3v 
    192          DO jk = 1, jpk 
    193             z3d(:,:,jk) =  e3v(:,:,jk,Kmm) 
    194          END DO  
     199         DO_3D( 0, 0, 0, 0, 1, jpk ) 
     200            z3d(ji,jj,jk) =  e3v(ji,jj,jk,Kmm) 
     201         END_3D 
    195202         CALL iom_put( "e3v" , z3d ) 
    196203      ENDIF 
    197204      IF ( iom_use("e3w") ) THEN                         ! time-varying e3w 
    198          DO jk = 1, jpk 
    199             z3d(:,:,jk) =  e3w(:,:,jk,Kmm) 
    200          END DO  
     205         DO_3D( 0, 0, 0, 0, 1, jpk ) 
     206            z3d(ji,jj,jk) =  e3w(ji,jj,jk,Kmm) 
     207         END_3D 
    201208         CALL iom_put( "e3w" , z3d ) 
    202209      ENDIF 
    203210      IF ( iom_use("e3f") ) THEN                         ! time-varying e3f caution here at Kaa 
    204           DO jk = 1, jpk 
    205             z3d(:,:,jk) =  e3f(:,:,jk) 
    206          END DO 
     211         DO_3D( 0, 0, 0, 0, 1, jpk ) 
     212            z3d(ji,jj,jk) =  e3f(ji,jj,jk) 
     213         END_3D 
    207214         CALL iom_put( "e3f" , z3d ) 
    208215      ENDIF 
    … …  
    224231      IF( iom_use("hf") )   CALL iom_put( "hf" , hf_0(:,:)*( 1._wp + r3f(:,:) ) )   ! water column at f-point (caution here at Naa) 
    225232#endif 
    226        
     233 
     234      ! --- tracers T&S --- !       
    227235      CALL iom_put( "toce_"//ttype, ts(:,:,:,jp_tem,Kmm) )    ! 3D temperature 
    228236      CALL iom_put(  "sst_"//ttype, ts(:,:,1,jp_tem,Kmm) )    ! surface temperature 
     237 
    229238      IF ( iom_use("sbt_"//ttype) ) THEN 
    230239         DO_2D( 0, 0, 0, 0 ) 
    … …  
    247256      IF( .NOT.lk_SWE )   CALL iom_put( "rhop", rhop(:,:,:) )          ! 3D potential density (sigma0) 
    248257 
     258      ! --- momentum --- ! 
    249259      IF ( iom_use("taubot") ) THEN                ! bottom stress 
    250260         zztmp = rho0 * 0.25_wp 
    … …  
    282292 
    283293      !                                            ! vertical velocity 
    284       IF( ln_zad_Aimp ) THEN   ;   IF( iom_use('woce') )   CALL iom_put( "woce", ww + wi )   ! explicit plus implicit parts 
    285       ELSE                     ;                           CALL iom_put( "woce", ww ) 
     294      IF( ln_zad_Aimp ) THEN 
     295         IF( iom_use('woce') ) THEN 
     296            DO_3D( 0, 0, 0, 0, 1, jpk ) 
     297               z3d(ji,jj,jk) = ww(ji,jj,jk) + wi(ji,jj,jk) 
     298            END_3D 
     299            CALL iom_put( "woce", z3d )   ! explicit plus implicit parts 
     300         ENDIF 
     301      ELSE 
     302         CALL iom_put( "woce", ww ) 
    286303      ENDIF 
    287304 
    288305      IF( iom_use('w_masstr') .OR. iom_use('w_masstr2') ) THEN   ! vertical mass transport & its square value 
    289306         !                     ! Caution: in the VVL case, it only correponds to the baroclinic mass transport. 
    290          DO jk = 1, jpk 
    291             IF( ln_zad_Aimp ) THEN 
    292                z3d(:,:,jk) = rho0 * e1e2t(:,:) * ( ww(:,:,jk) + wi(:,:,jk) ) 
    293             ELSE 
    294                z3d(:,:,jk) = rho0 * e1e2t(:,:) * ww(:,:,jk) 
    295             ENDIF 
    296          END DO 
     307         IF( ln_zad_Aimp ) THEN 
     308            DO_3D( 0, 0, 0, 0, 1, jpk ) 
     309               z3d(ji,jj,jk) = rho0 * e1e2t(ji,jj) * ( ww(ji,jj,jk) + wi(ji,jj,jk) ) 
     310            END_3D 
     311         ELSE 
     312            DO_3D( 0, 0, 0, 0, 1, jpk ) 
     313               z3d(ji,jj,jk) = rho0 * e1e2t(ji,jj) * ww(ji,jj,jk) 
     314            END_3D 
     315         ENDIF 
    297316         CALL iom_put( "w_masstr" , z3d )   
    298317         IF( iom_use('w_masstr2') )   CALL iom_put( "w_masstr2", z3d * z3d ) 
    … …  
    366385      ! 
    367386      IF ( iom_use("ke") .OR. iom_use("ke_int") ) THEN 
    368          z3d(:,:,jpk) = 0._wp  
    369          DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     387         DO_3D( 0, 0, 0, 0, 1, jpk ) 
    370388            zztmpx = uu(ji-1,jj  ,jk,Kmm) + uu(ji,jj,jk,Kmm) 
    371389            zztmpy = vv(ji  ,jj-1,jk,Kmm) + vv(ji,jj,jk,Kmm) 
    … …  
    409427      IF( iom_use("u_masstr") .OR. iom_use("u_masstr_vint") .OR. iom_use("u_heattr") .OR. iom_use("u_salttr") ) THEN 
    410428          
    411          z3d(:,:,jpk) = 0._wp 
    412          DO jk = 1, jpkm1 
    413             z3d(:,:,jk) = rho0 * uu(:,:,jk,Kmm) * e2u(:,:) * e3u(:,:,jk,Kmm) * umask(:,:,jk) 
    414          END DO 
     429         DO_3D( 0, 0, 0, 0, 1, jpk ) 
     430            z3d(ji,jj,jk) = rho0 * uu(ji,jj,jk,Kmm) * e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * umask(ji,jj,jk) 
     431         END_3D 
    415432         CALL iom_put( "u_masstr"     , z3d )      ! mass transport in i-direction 
    416433          
    … …  
    418435            z2d(:,:) = 0._wp  
    419436            DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    420                z2d(:,:) = z2d(:,:) + z3d(:,:,jk) 
     437               z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) 
    421438            END_3D 
    422439            CALL iom_put( "u_masstr_vint", z2d )   ! mass transport in i-direction vertical sum 
    … …  
    442459      IF( iom_use("v_masstr") .OR. iom_use("v_heattr") .OR. iom_use("v_salttr") ) THEN 
    443460          
    444          z3d(:,:,jpk) = 0._wp 
    445          DO jk = 1, jpkm1 
    446             z3d(:,:,jk) = rho0 * vv(:,:,jk,Kmm) * e1v(:,:) * e3v(:,:,jk,Kmm) * vmask(:,:,jk) 
    447          END DO 
     461         DO_3D( 0, 0, 0, 0, 1, jpk ) 
     462            z3d(ji,jj,jk) = rho0 * vv(ji,jj,jk,Kmm) * e1v(ji,jj) * e3v(ji,jj,jk,Kmm) * vmask(ji,jj,jk) 
     463         END_3D 
    448464         CALL iom_put( "v_masstr", z3d )           ! mass transport in j-direction 
    449465          

  • NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/OCE/DYN/dynldf_iso.F90

    r14834 r15122  
    131131            !                                      ! allocate dyn_ldf_iso arrays 
    132132            IF( dyn_ldf_iso_alloc() /= 0 )   CALL ctl_stop('STOP', 'dyn_ldf_iso: failed to allocate arrays') 
     133            ! 
     134            DO_2D_OVR( 0, 0, 0, 0 ) 
     135               akzu(ji,jj,1)   = 0._wp 
     136               akzu(ji,jj,jpk) = 0._wp 
     137               akzv(ji,jj,1)   = 0._wp 
     138               akzv(ji,jj,jpk) = 0._wp 
     139            END_2D 
     140            ! 
    133141         ENDIF 
    134142      ENDIF 

  • NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/OCE/ICB/icbclv.F90

    r14030 r15122  
    133133                  newpt%lon = glamt(ji,jj)         ! at t-point (centre of the cell) 
    134134                  newpt%lat = gphit(ji,jj) 
    135                   newpt%xi  = REAL( mig(ji), wp ) 
    136                   newpt%yj  = REAL( mjg(jj), wp ) 
     135                  newpt%xi  = REAL( mig(ji), wp ) - ( nn_hls - 1 ) 
     136                  newpt%yj  = REAL( mjg(jj), wp ) - ( nn_hls - 1 ) 
    137137                  ! 
    138138                  newpt%uvel = 0._wp               ! initially at rest 

  • NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/OCE/ICB/icbdyn.F90

    r14400 r15122  
    192192      ld_bounced = .FALSE. 
    193193      ! 
    194       ii0 = INT( pi0+0.5 )   ;   ij0 = INT( pj0+0.5 )       ! initial gridpoint position (T-cell) 
    195       ii  = INT( pi +0.5 )   ;   ij  = INT( pj +0.5 )       ! current     -         - 
     194      ii0 = INT( pi0+0.5 ) + (nn_hls-1)   ;   ij0 = INT( pj0+0.5 ) + (nn_hls-1)      ! initial gridpoint position (T-cell) 
     195      ii  = INT( pi +0.5 ) + (nn_hls-1)   ;   ij  = INT( pj +0.5 ) + (nn_hls-1)      ! current     -         - 
    196196      ! 
    197197      IF( ii == ii0  .AND.  ij == ij0  )   RETURN           ! berg remains in the same cell 
    … …  
    314314      zwmod  = zuwave*zuwave + zvwave*zvwave          ! The wave amplitude and length depend on the  current; 
    315315      !                                               ! wind speed relative to the ocean. Actually wmod is wmod**2 here. 
    316       zampl        = 0.5 * 0.02025 * zwmod            ! This is "a", the wave amplitude 
    317       zLwavelength =       0.32    * zwmod            ! Surface wave length fitted to data in table at 
     316      zampl        = 0.5_wp * 0.02025_wp * zwmod      ! This is "a", the wave amplitude 
     317      zLwavelength =       0.32_wp    * zwmod         ! Surface wave length fitted to data in table at 
    318318      !                                               ! http://www4.ncsu.edu/eos/users/c/ceknowle/public/chapter10/part2.html 
    319       zLcutoff     = 0.125 * zLwavelength 
    320       zLtop        = 0.25  * zLwavelength 
    321       zCr          = pp_Cr0 * MIN(  MAX( 0., (zL-zLcutoff) / ((zLtop-zLcutoff)+1.e-30)) , 1.)  ! Wave radiation coefficient 
     319      zLcutoff     = 0.125_wp * zLwavelength 
     320      zLtop        = 0.25_wp  * zLwavelength 
     321      zCr          = pp_Cr0 * MIN(  MAX( 0._wp, (zL-zLcutoff) / ((zLtop-zLcutoff)+1.e-30)) , 1._wp)  ! Wave radiation coefficient 
    322322      !                                               ! fitted to graph from Carrieres et al.,  POAC Drift Model. 
    323       zwave_rad    = 0.5 * pp_rho_seawater / zM * zCr * grav * zampl * MIN( zampl,zF ) * (2.*zW*zL) / (zW+zL) 
     323      zwave_rad    = 0.5_wp * pp_rho_seawater / zM * zCr * grav * zampl * MIN( zampl,zF ) * (2._wp*zW*zL) / (zW+zL) 
    324324      zwmod        = SQRT( zua*zua + zva*zva )        ! Wind speed 
    325325      IF( zwmod /= 0._wp ) THEN 
    … …  
    327327         zvwave = zva/zwmod 
    328328      ELSE 
    329          zuwave = 0.   ;    zvwave=0.   ;    zwave_rad=0. ! ... and only when wind is present.     !!gm  wave_rad=0. is useless 
     329         zuwave = 0._wp   ;    zvwave=0._wp   ;    zwave_rad=0._wp ! ... and only when wind is present.     !!gm  wave_rad=0. is useless 
    330330      ENDIF 
    331331 
    332332      ! Weighted drag coefficients 
    333       z_ocn = pp_rho_seawater / zM * (0.5*pp_Cd_wv*zW*(zD_hi)+pp_Cd_wh*zW*zL) 
    334       z_atm = pp_rho_air      / zM * (0.5*pp_Cd_av*zW*zF     +pp_Cd_ah*zW*zL) 
    335       z_ice = pp_rho_ice      / zM * (0.5*pp_Cd_iv*zW*zhi              ) 
     333      z_ocn = pp_rho_seawater / zM * (0.5_wp*pp_Cd_wv*zW*(zD_hi)+pp_Cd_wh*zW*zL) 
     334      z_atm = pp_rho_air      / zM * (0.5_wp*pp_Cd_av*zW*zF     +pp_Cd_ah*zW*zL) 
     335      z_ice = pp_rho_ice      / zM * (0.5_wp*pp_Cd_iv*zW*zhi              ) 
    336336      IF( abs(zui) + abs(zvi) == 0._wp )   z_ice = 0._wp 
    337337 
    … …  
    358358      DO itloop = 1, 2  ! Iterate on drag coefficients 
    359359         ! 
    360          zus = 0.5 * ( zuveln + puvel ) 
    361          zvs = 0.5 * ( zvveln + pvvel ) 
     360         zus = 0.5_wp * ( zuveln + puvel ) 
     361         zvs = 0.5_wp * ( zvveln + pvvel ) 
    362362         zdrag_ocn = z_ocn * SQRT( (zus-zuo)*(zus-zuo) + (zvs-zvo)*(zvs-zvo) ) 
    363363         zdrag_atm = z_atm * SQRT( (zus-zua)*(zus-zua) + (zvs-zva)*(zvs-zva) ) 

  • NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/OCE/ICB/icbini.F90

    r14433 r15122  
    182182      i3 = INT( src_calving(i1,jpj/2) ) 
    183183      jj = INT( i3/nicbpack ) 
    184       ricb_left = REAL( i3 - nicbpack*jj, wp ) 
     184      ricb_left = REAL( i3 - nicbpack*jj, wp ) - (nn_hls-1) 
    185185      i1 = MIN( nicbei+1, jpi ) 
    186186      i3 = INT( src_calving(i1,jpj/2) ) 
    187187      jj = INT( i3/nicbpack ) 
    188       ricb_right = REAL( i3 - nicbpack*jj, wp ) 
     188      ricb_right = REAL( i3 - nicbpack*jj, wp ) - (nn_hls-1) 
    189189       
    190190      ! north fold 
    … …  
    360360                rn_test_box(3) < gphit(ji,jj) .AND. gphit(ji,jj) < rn_test_box(4) ) THEN 
    361361               localberg%mass_scaling = rn_mass_scaling(iberg) 
    362                localpt%xi = REAL( mig(ji), wp ) 
    363                localpt%yj = REAL( mjg(jj), wp ) 
     362               localpt%xi = REAL( mig(ji) - (nn_hls-1), wp ) 
     363               localpt%yj = REAL( mjg(jj) - (nn_hls-1), wp ) 
    364364               CALL icb_utl_interp( localpt%xi, localpt%yj, plat=localpt%lat, plon=localpt%lon )    
    365365               localpt%mass      = rn_initial_mass     (iberg) 

  • NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/OCE/ICB/icblbc.F90

    r14433 r15122  
    229229         DO WHILE (ASSOCIATED(this)) 
    230230            pt => this%current_point 
    231             IF( ipe_E >= 0 .AND. pt%xi > REAL(mig(nicbei),wp) + 0.5_wp ) THEN 
     231            IF( ipe_E >= 0 .AND. pt%xi > REAL(mig(nicbei),wp) + 0.5_wp - (nn_hls-1) ) THEN 
    232232               tmpberg => this 
    233233               this => this%next 
    … …  
    242242               CALL icb_pack_into_buffer( tmpberg, obuffer_e, ibergs_to_send_e) 
    243243               CALL icb_utl_delete(first_berg, tmpberg) 
    244             ELSE IF( ipe_W >= 0 .AND. pt%xi < REAL(mig(nicbdi),wp) - 0.5_wp ) THEN 
     244            ELSE IF( ipe_W >= 0 .AND. pt%xi < REAL(mig(nicbdi),wp) - 0.5_wp - (nn_hls-1) ) THEN 
    245245               tmpberg => this 
    246246               this => this%next 
    … …  
    321321         DO WHILE (ASSOCIATED(this)) 
    322322            pt => this%current_point 
    323             IF( ipe_N >= 0 .AND. pt%yj > REAL(mjg(nicbej),wp) + 0.5_wp ) THEN 
     323            IF( ipe_N >= 0 .AND. pt%yj > REAL(mjg(nicbej),wp) + 0.5_wp - (nn_hls-1) ) THEN 
    324324               tmpberg => this 
    325325               this => this%next 
    … …  
    331331               CALL icb_pack_into_buffer( tmpberg, obuffer_n, ibergs_to_send_n) 
    332332               CALL icb_utl_delete(first_berg, tmpberg) 
    333             ELSE IF( ipe_S >= 0 .AND. pt%yj < REAL(mjg(nicbdj),wp) - 0.5_wp ) THEN 
     333            ELSE IF( ipe_S >= 0 .AND. pt%yj < REAL(mjg(nicbdj),wp) - 0.5_wp - (nn_hls-1) ) THEN 
    334334               tmpberg => this 
    335335               this => this%next 
    … …  
    442442         DO WHILE (ASSOCIATED(this)) 
    443443            pt => this%current_point 
    444             IF( pt%xi < REAL(mig(nicbdi),wp) - 0.5_wp .OR. & 
    445                 pt%xi > REAL(mig(nicbei),wp) + 0.5_wp .OR. & 
    446                 pt%yj < REAL(mjg(nicbdj),wp) - 0.5_wp .OR. & 
    447                 pt%yj > REAL(mjg(nicbej),wp) + 0.5_wp ) THEN 
     444            IF( pt%xi < REAL(mig(nicbdi),wp) - 0.5_wp - (nn_hls-1) .OR. & 
     445                pt%xi > REAL(mig(nicbei),wp) + 0.5_wp - (nn_hls-1) .OR. & 
     446                pt%yj < REAL(mjg(nicbdj),wp) - 0.5_wp - (nn_hls-1) .OR. & 
     447                pt%yj > REAL(mjg(nicbej),wp) + 0.5_wp - (nn_hls-1) ) THEN 
    448448               i = i + 1 
    449449               WRITE(numicb,*) 'berg lost in halo: ', this%number(:) 
    … …  
    514514               DO WHILE (ASSOCIATED(this)) 
    515515                  pt => this%current_point 
    516                   iine = INT( pt%xi + 0.5 ) 
     516                  iine = INT( pt%xi + 0.5 ) + (nn_hls-1) 
    517517                  iproc = nicbflddest(mi1(iine)) 
    518                   IF( pt%yj > REAL(mjg(nicbej),wp) + 0.5_wp ) THEN 
     518                  IF( pt%yj > REAL(mjg(nicbej),wp) + 0.5_wp - (nn_hls-1) ) THEN 
    519519                     IF( iproc == ifldproc ) THEN 
    520520                        ! 
    … …  
    592592               DO WHILE (ASSOCIATED(this)) 
    593593                  pt => this%current_point 
    594                   iine = INT( pt%xi + 0.5 ) 
    595                   ijne = INT( pt%yj + 0.5 ) 
     594                  iine = INT( pt%xi + 0.5 ) + (nn_hls-1) 
     595                  ijne = INT( pt%yj + 0.5 ) + (nn_hls-1) 
    596596                  ipts  = nicbfldpts (mi1(iine)) 
    597597                  iproc = nicbflddest(mi1(iine)) 
    598                   IF( pt%yj > REAL(mjg(nicbej),wp) + 0.5_wp ) THEN 
     598                  IF( pt%yj > REAL(mjg(nicbej),wp) + 0.5_wp - (nn_hls-1) ) THEN 
    599599                     IF( iproc == ifldproc ) THEN 
    600600                        ! 

  • NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/OCE/ICB/icbrst.F90

    r15080 r15122  
    8989            CALL iom_get( ncid, 'yj'     ,localpt%yj  , ktime=jn ) 
    9090 
    91             ii = INT( localpt%xi + 0.5 ) 
    92             ij = INT( localpt%yj + 0.5 ) 
     91            ii = INT( localpt%xi + 0.5 ) + ( nn_hls-1 ) 
     92            ij = INT( localpt%yj + 0.5 ) + ( nn_hls-1 ) 
    9393            ! Only proceed if this iceberg is on the local processor (excluding halos). 
    9494            IF ( ii >= mig(Nis0) .AND. ii <= mig(Nie0) .AND.   & 

  • NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/OCE/ICB/icbthm.F90

    r14773 r15122  
    113113         zyj  = pt%yj 
    114114         ii  = INT( zxi + 0.5 )                            ! T-cell of the berg 
    115          ii  = mi1( ii ) 
     115         ii  = mi1( ii + (nn_hls-1) ) 
    116116         ij  = INT( zyj + 0.5 )               
    117          ij  = mj1( ij ) 
     117         ij  = mj1( ij + (nn_hls-1) ) 
    118118         zVol = zT * zW * zL 
    119119 
    … …  
    203203            zLbits   = MIN( zL, zW, zT, 40._wp )                                     ! assume bergy bits are smallest dimension or 40 meters 
    204204            zAbits   = ( zMbits / rn_rho_bergs ) / zLbits                            ! Effective bottom area (assuming T=Lbits) 
    205             zMbb     = MAX( 0.58_wp*(zdvo**0.8_wp)*(zSST+2._wp) /   & 
     205            zMbb     = MAX( 0.58_wp*(zdvob**0.8_wp)*(zSST+2._wp) /   & 
    206206               &                              ( zLbits**0.2_wp ) , 0._wp ) * z1_rday ! Basal turbulent melting (for bits) 
    207207            zMbb     = rn_rho_bergs * zAbits * zMbb                                  ! in kg/s 

  • NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/OCE/ICB/icbutl.F90

    r14400 r15122  
    300300         zwj = pj - 0.5_wp - REAL(kij,wp) 
    301301      END SELECT 
     302      kii = kii + (nn_hls-1) 
     303      kij = kij + (nn_hls-1) 
    302304      ! 
    303305      ! compute weight 
    … …  
    461463 
    462464      ! conversion to local domain (no need to do a sanity check already done in icbpos) 
    463       ii = mi1(ii) 
    464       ij = mj1(ij) 
     465      ii = mi1(ii) + (nn_hls-1) 
     466      ij = mj1(ij) + (nn_hls-1) 
    465467      ! 
    466468      IF(    0.0_wp <= zi .AND. zi < 0.5_wp   ) THEN 

  • NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/OCE/ISF/isfcav.F90

    r15004 r15122  
    2222   USE isfdiags , ONLY: isf_diags_flx  ! ice shelf diags subroutine 
    2323   ! 
    24    USE oce      , ONLY: ts                              ! ocean tracers 
     24   USE oce      , ONLY: ts, uu, vv, rn2                 ! ocean dynamics and tracers 
     25   USE dom_oce                                          ! ocean space and time domain 
    2526   USE par_oce  , ONLY: jpi,jpj                         ! ocean space and time domain 
    2627   USE phycst   , ONLY: grav,rho0,rho0_rcp,r1_rho0_rcp  ! physical constants 
    … …  
    3132   USE fldread        ! read input field at current time step 
    3233   USE lbclnk         ! lbclnk 
     34   USE lib_mpp        ! MPP library 
    3335 
    3436   IMPLICIT NONE 
    … …  
    3840   PUBLIC   isf_cav, isf_cav_init ! routine called in isfmlt 
    3941 
     42   !! * Substitutions    
     43#  include "do_loop_substitute.h90" 
     44#  include "domzgr_substitute.h90" 
    4045   !!---------------------------------------------------------------------- 
    4146   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    7176      !!--------------------------------------------------------------------- 
    7277      LOGICAL :: lit 
    73       INTEGER :: nit 
     78      INTEGER :: nit, ji, jj, ikt 
    7479      REAL(wp) :: zerr 
     80      REAL(wp) :: zcoef, zdku, zdkv 
    7581      REAL(wp), DIMENSION(jpi,jpj) :: zqlat, zqoce, zqhc, zqh  ! heat fluxes 
    76       REAL(wp), DIMENSION(jpi,jpj) :: zqoce_b                  ! 
     82      REAL(wp), DIMENSION(jpi,jpj) :: zqh_b, zRc               ! 
    7783      REAL(wp), DIMENSION(jpi,jpj) :: zgammat, zgammas         ! exchange coeficient 
    7884      REAL(wp), DIMENSION(jpi,jpj) :: zttbl, zstbl             ! temp. and sal. in top boundary layer 
    … …  
    8894      ! 
    8995      ! initialisation 
    90       IF (TRIM(cn_gammablk) == 'vel_stab' ) zqoce_b (:,:) = ptsc(:,:,jp_tem) * rho0_rcp ! last time step total heat fluxes (to speed up convergence) 
     96      IF ( TRIM(cn_gammablk) == 'vel_stab' ) THEN 
     97         zqoce(:,:) = -pqfwf(:,:) * rLfusisf !  
     98         zqh_b(:,:) =  ptsc(:,:,jp_tem) * rho0_rcp ! last time step total heat fluxes (to speed up convergence) 
     99 
     100         DO_2D( 0, 0, 0, 0 ) 
     101            ikt = mikt(ji,jj) 
     102            ! compute Rc number (as done in zdfric.F90) 
     103!!gm better to do it like in the new zdfric.F90   i.e. avm weighted Ri computation 
     104            zcoef = 0.5_wp / e3w(ji,jj,ikt+1,Kmm) 
     105            !                                            ! shear of horizontal velocity 
     106            zdku = zcoef * (  uu(ji-1,jj  ,ikt  ,Kmm) + uu(ji,jj,ikt  ,Kmm)  & 
     107               &             -uu(ji-1,jj  ,ikt+1,Kmm) - uu(ji,jj,ikt+1,Kmm)  ) 
     108            zdkv = zcoef * (  vv(ji  ,jj-1,ikt  ,Kmm) + vv(ji,jj,ikt  ,Kmm)  & 
     109               &             -vv(ji  ,jj-1,ikt+1,Kmm) - vv(ji,jj,ikt+1,Kmm)  ) 
     110            !                                            ! richardson number (minimum value set to zero) 
     111            zRc(ji,jj) = MAX(rn2(ji,jj,ikt+1), 1.e-20_wp) / MAX( zdku*zdku + zdkv*zdkv, 1.e-20_wp ) 
     112         END_2D 
     113         CALL lbc_lnk( 'isfmlt', zRc, 'T', 1._wp ) 
     114      ENDIF 
    91115      ! 
    92116      ! compute ice shelf melting 
    … …  
    97121         ! useless if melt specified 
    98122         IF ( TRIM(cn_isfcav_mlt) .NE. 'spe' ) THEN 
    99             CALL isfcav_gammats( Kmm, zttbl, zstbl, zqoce  , pqfwf, & 
     123            CALL isfcav_gammats( Kmm, zttbl, zstbl, zqoce  , pqfwf, zRc, & 
    100124               &                                    zgammat, zgammas ) 
    101125         END IF 
    … …  
    112136         CASE ( 'vel_stab' ) 
    113137            ! compute error between 2 iterations 
    114             zerr = MAXVAL(ABS(zqoce(:,:) - zqoce_b(:,:))) 
     138            zerr = 0._wp 
     139            DO_2D( 0, 0, 0, 0 ) 
     140               zerr = MAX( zerr, ABS(zqhc(ji,jj)+zqoce(ji,jj) - zqh_b(ji,jj)) ) 
     141            END_2D 
     142            CALL mpp_max( 'isfcav', zerr )   ! max over the global domain 
    115143            ! 
    116144            ! define if iteration needed 
    … …  
    121149            ELSE                              ! converge is not yet achieve 
    122150               nit = nit + 1 
    123                zqoce_b(:,:) = zqoce(:,:) 
     151               zqh_b(:,:) = zqhc(:,:)+zqoce(:,:) 
    124152            END IF 
    125153         END SELECT 
    … …  
    127155      END DO 
    128156      ! 
    129       ! compute heat and water flux ( > 0 from isf to oce) 
    130       pqfwf(:,:) = pqfwf(:,:) * mskisf_cav(:,:) 
    131       zqoce(:,:) = zqoce(:,:) * mskisf_cav(:,:) 
    132       zqhc (:,:) = zqhc(:,:)  * mskisf_cav(:,:) 
    133       ! 
    134       ! compute heat content flux ( > 0 from isf to oce) 
    135       zqlat(:,:) = - pqfwf(:,:) * rLfusisf    ! 2d latent heat flux (W/m2) 
    136       ! 
    137       ! total heat flux ( > 0 from isf to oce) 
    138       zqh(:,:) = ( zqhc (:,:) + zqoce(:,:) ) 
    139       ! 
    140       ! lbclnk on melt 
    141       CALL lbc_lnk( 'isfmlt', zqh, 'T', 1.0_wp, pqfwf, 'T', 1.0_wp) 
     157      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
     158         ! compute heat and water flux ( > 0 from isf to oce) 
     159         pqfwf(ji,jj) = pqfwf(ji,jj) * mskisf_cav(ji,jj) 
     160         zqoce(ji,jj) = zqoce(ji,jj) * mskisf_cav(ji,jj) 
     161         zqhc (ji,jj) = zqhc(ji,jj)  * mskisf_cav(ji,jj) 
     162         ! 
     163         ! compute heat content flux ( > 0 from isf to oce) 
     164         zqlat(ji,jj) = - pqfwf(ji,jj) * rLfusisf    ! 2d latent heat flux (W/m2) 
     165         ! 
     166         ! total heat flux ( > 0 from isf to oce) 
     167         zqh(ji,jj) = ( zqhc (ji,jj) + zqoce(ji,jj) ) 
     168         ! 
     169         ! set temperature content 
     170         ptsc(ji,jj,jp_tem) = zqh(ji,jj) * r1_rho0_rcp 
     171      END_2D 
    142172      ! 
    143173      ! output fluxes 
    144174      CALL isf_diags_flx( Kmm, misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav, 'cav', pqfwf, zqoce, zqlat, zqhc) 
    145       ! 
    146       ! set temperature content 
    147       ptsc(:,:,jp_tem) = zqh(:,:) * r1_rho0_rcp 
    148175      ! 
    149176      ! write restart variables (qoceisf, qhcisf, fwfisf for now and before) 

  • NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/OCE/ISF/isfcavgam.F90

    r13237 r15122  
    1414   USE isftbl  , ONLY: isf_tbl 
    1515 
    16    USE oce     , ONLY: uu, vv, rn2         ! ocean dynamics and tracers 
     16   USE oce     , ONLY: uu, vv              ! ocean dynamics 
    1717   USE phycst  , ONLY: grav, vkarmn        ! physical constant 
    1818   USE eosbn2  , ONLY: eos_rab             ! equation of state 
    … …  
    3030   PUBLIC   isfcav_gammats 
    3131 
     32   !! * Substitutions    
     33#  include "do_loop_substitute.h90" 
    3234#  include "domzgr_substitute.h90" 
    3335   !!---------------------------------------------------------------------- 
    … …  
    4244   !!----------------------------------------------------------------------------------------------------- 
    4345   ! 
    44    SUBROUTINE isfcav_gammats( Kmm, pttbl, pstbl, pqoce, pqfwf, pgt, pgs ) 
     46   SUBROUTINE isfcav_gammats( Kmm, pttbl, pstbl, pqoce, pqfwf, pRc, pgt, pgs ) 
    4547      !!---------------------------------------------------------------------- 
    4648      !! ** Purpose    : compute the coefficient echange for heat and fwf flux 
    … …  
    5557      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pqoce, pqfwf    ! isf heat and fwf 
    5658      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pttbl, pstbl    ! top boundary layer tracer 
     59      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pRc             ! Richardson number 
    5760      !!--------------------------------------------------------------------- 
    5861      REAL(wp), DIMENSION(jpi,jpj)                :: zutbl, zvtbl    ! top boundary layer velocity 
    … …  
    9295         pgs(:,:) = rn_gammas0 
    9396      CASE ( 'vel' ) ! gamma is proportional to u* 
    94          CALL gammats_vel      (                   zutbl, zvtbl, rCd0_top, r_ke0_top,               pgt, pgs ) 
     97         CALL gammats_vel      (                   zutbl, zvtbl, rCd0_top, r_ke0_top,                    pgt, pgs ) 
    9598      CASE ( 'vel_stab' ) ! gamma depends of stability of boundary layer and u* 
    96          CALL gammats_vel_stab (Kmm, pttbl, pstbl, zutbl, zvtbl, rCd0_top, r_ke0_top, pqoce, pqfwf, pgt, pgs ) 
     99         CALL gammats_vel_stab (Kmm, pttbl, pstbl, zutbl, zvtbl, rCd0_top, r_ke0_top, pqoce, pqfwf, pRc, pgt, pgs ) 
    97100      CASE DEFAULT 
    98101         CALL ctl_stop('STOP','method to compute gamma (cn_gammablk) is unknown (should not see this)') 
    … …  
    133136      REAL(wp),                     INTENT(in   ) :: pke2         ! background velocity 
    134137      !!--------------------------------------------------------------------- 
     138      INTEGER  :: ji, jj                     ! loop index 
    135139      REAL(wp), DIMENSION(jpi,jpj) :: zustar 
    136140      !!--------------------------------------------------------------------- 
    137141      ! 
    138       ! compute ustar (AD15 eq. 27) 
    139       zustar(:,:) = SQRT( pCd(:,:) * ( putbl(:,:) * putbl(:,:) + pvtbl(:,:) * pvtbl(:,:) + pke2 ) ) * mskisf_cav(:,:) 
    140       ! 
    141       ! Compute gammats 
    142       pgt(:,:) = zustar(:,:) * rn_gammat0 
    143       pgs(:,:) = zustar(:,:) * rn_gammas0 
     142      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
     143         ! compute ustar (AD15 eq. 27) 
     144         zustar(ji,jj) = SQRT( pCd(ji,jj) * ( putbl(ji,jj) * putbl(ji,jj) + pvtbl(ji,jj) * pvtbl(ji,jj) + pke2 ) ) * mskisf_cav(ji,jj) 
     145         ! 
     146         ! Compute gammats 
     147         pgt(ji,jj) = zustar(ji,jj) * rn_gammat0 
     148         pgs(ji,jj) = zustar(ji,jj) * rn_gammas0 
     149      END_2D 
    144150      ! 
    145151      ! output ustar 
    … …  
    148154   END SUBROUTINE gammats_vel 
    149155 
    150    SUBROUTINE gammats_vel_stab( Kmm, pttbl, pstbl, putbl, pvtbl, pCd, pke2, pqoce, pqfwf, &  ! <<== in 
    151       &                                                                     pgt  , pgs    )  ! ==>> out gammats [m/s] 
     156   SUBROUTINE gammats_vel_stab( Kmm, pttbl, pstbl, putbl, pvtbl, pCd, pke2, pqoce, pqfwf, pRc, &  ! <<== in 
     157      &                                                                     pgt  , pgs         )  ! ==>> out gammats [m/s] 
    152158      !!---------------------------------------------------------------------- 
    153159      !! ** Purpose    : compute the coefficient echange coefficient  
    … …  
    166172      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: putbl, pvtbl   ! velocity in the losch top boundary layer 
    167173      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pttbl, pstbl   ! tracer   in the losch top boundary layer 
     174      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pRc            ! Richardson number 
    168175      !!--------------------------------------------------------------------- 
    169176      INTEGER  :: ji, jj                     ! loop index 
    170177      INTEGER  :: ikt                        ! local integer 
    171178      REAL(wp) :: zdku, zdkv                 ! U, V shear  
    172       REAL(wp) :: zPr, zSc, zRc              ! Prandtl, Scmidth and Richardson number  
     179      REAL(wp) :: zPr, zSc                   ! Prandtl and Scmidth number  
    173180      REAL(wp) :: zmob, zmols                ! Monin Obukov length, coriolis factor at T point 
    174181      REAL(wp) :: zbuofdep, zhnu             ! Bouyancy length scale, sublayer tickness 
    … …  
    185192      !!--------------------------------------------------------------------- 
    186193      ! 
    187       ! compute ustar 
    188       zustar(:,:) = SQRT( pCd * ( putbl(:,:) * putbl(:,:) + pvtbl(:,:) * pvtbl(:,:) + pke2 ) ) 
    189       ! 
    190       ! output ustar 
    191       CALL iom_put('isfustar',zustar(:,:)) 
    192       ! 
    193194      ! compute Pr and Sc number (eq ??) 
    194195      zPr =   13.8_wp 
    … …  
    200201      ! 
    201202      ! compute gamma 
    202       DO ji = 2, jpi 
    203          DO jj = 2, jpj 
    204             ikt = mikt(ji,jj) 
    205  
    206             IF( zustar(ji,jj) == 0._wp ) THEN           ! only for kt = 1 I think 
    207                pgt = rn_gammat0 
    208                pgs = rn_gammas0 
    209             ELSE 
    210                ! compute Rc number (as done in zdfric.F90) 
    211 !!gm better to do it like in the new zdfric.F90   i.e. avm weighted Ri computation 
    212                zcoef = 0.5_wp / e3w(ji,jj,ikt+1,Kmm) 
    213                !                                            ! shear of horizontal velocity 
    214                zdku = zcoef * (  uu(ji-1,jj  ,ikt  ,Kmm) + uu(ji,jj,ikt  ,Kmm)  & 
    215                   &             -uu(ji-1,jj  ,ikt+1,Kmm) - uu(ji,jj,ikt+1,Kmm)  ) 
    216                zdkv = zcoef * (  vv(ji  ,jj-1,ikt  ,Kmm) + vv(ji,jj,ikt  ,Kmm)  & 
    217                   &             -vv(ji  ,jj-1,ikt+1,Kmm) - vv(ji,jj,ikt+1,Kmm)  ) 
    218                !                                            ! richardson number (minimum value set to zero) 
    219                zRc = MAX(rn2(ji,jj,ikt+1), 0._wp) / MAX( zdku*zdku + zdkv*zdkv, zeps ) 
    220  
    221                ! compute bouyancy  
    222                zts(jp_tem) = pttbl(ji,jj) 
    223                zts(jp_sal) = pstbl(ji,jj) 
    224                zdep        = gdepw(ji,jj,ikt,Kmm) 
    225                ! 
    226                CALL eos_rab( zts, zdep, zab, Kmm ) 
    227                ! 
    228                ! compute length scale (Eq ??) 
    229                zbuofdep = grav * ( zab(jp_tem) * pqoce(ji,jj) - zab(jp_sal) * pqfwf(ji,jj) ) 
    230                ! 
    231                ! compute Monin Obukov Length 
    232                ! Maximum boundary layer depth (Eq ??) 
    233                zhmax = gdept(ji,jj,mbkt(ji,jj),Kmm) - gdepw(ji,jj,mikt(ji,jj),Kmm) -0.001_wp 
    234                ! 
    235                ! Compute Monin obukhov length scale at the surface and Ekman depth: (Eq ??) 
    236                zmob   = zustar(ji,jj) ** 3 / (vkarmn * (zbuofdep + zeps)) 
    237                zmols  = SIGN(1._wp, zmob) * MIN(ABS(zmob), zhmax) * tmask(ji,jj,ikt) 
    238                ! 
    239                ! compute eta* (stability parameter) (Eq ??) 
    240                zetastar = 1._wp / ( SQRT(1._wp + MAX(zxsiN * zustar(ji,jj) / ( ABS(ff_f(ji,jj)) * zmols * zRc ), 0._wp))) 
    241                ! 
    242                ! compute the sublayer thickness (Eq ??) 
    243                zhnu = 5 * znu / zustar(ji,jj) 
    244                ! 
    245                ! compute gamma turb (Eq ??) 
    246                zgturb = 1._wp / vkarmn * LOG(zustar(ji,jj) * zxsiN * zetastar * zetastar / ( ABS(ff_f(ji,jj)) * zhnu )) & 
     203      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
     204 
     205         ikt = mikt(ji,jj) 
     206 
     207         ! compute ustar 
     208         zustar(ji,jj) = SQRT( pCd(ji,jj) * ( putbl(ji,jj) * putbl(ji,jj) + pvtbl(ji,jj) * pvtbl(ji,jj) + pke2 ) ) 
     209 
     210         IF( zustar(ji,jj) == 0._wp ) THEN           ! only for kt = 1 I think 
     211            pgt(ji,jj) = rn_gammat0 
     212            pgs(ji,jj) = rn_gammas0 
     213         ELSE 
     214            ! compute bouyancy  
     215            zts(jp_tem) = pttbl(ji,jj) 
     216            zts(jp_sal) = pstbl(ji,jj) 
     217            zdep        = gdepw(ji,jj,ikt,Kmm) 
     218            ! 
     219            CALL eos_rab( zts, zdep, zab, Kmm ) 
     220            ! 
     221            ! compute length scale (Eq ??) 
     222            zbuofdep = grav * ( zab(jp_tem) * pqoce(ji,jj) - zab(jp_sal) * pqfwf(ji,jj) ) 
     223            ! 
     224            ! compute Monin Obukov Length 
     225            ! Maximum boundary layer depth (Eq ??) 
     226            zhmax = gdept(ji,jj,mbkt(ji,jj),Kmm) - gdepw(ji,jj,mikt(ji,jj),Kmm) -0.001_wp 
     227            ! 
     228            ! Compute Monin obukhov length scale at the surface and Ekman depth: (Eq ??) 
     229            zmob   = zustar(ji,jj) ** 3 / (vkarmn * (zbuofdep + zeps)) 
     230            zmols  = SIGN(1._wp, zmob) * MIN(ABS(zmob), zhmax) * tmask(ji,jj,ikt) 
     231            ! 
     232            ! compute eta* (stability parameter) (Eq ??) 
     233            zetastar = 1._wp / ( SQRT(1._wp + MAX( 0._wp, zxsiN * zustar(ji,jj) & 
     234               &                                        / MAX( 1.e-20, ABS(ff_t(ji,jj)) * zmols * pRc(ji,jj) ) ))) 
     235            ! 
     236            ! compute the sublayer thickness (Eq ??) 
     237            zhnu = 5 * znu / MAX( 1.e-20, zustar(ji,jj) ) 
     238            ! 
     239            ! compute gamma turb (Eq ??) 
     240            zgturb = 1._wp / vkarmn * LOG(zustar(ji,jj) * zxsiN * zetastar * zetastar / MAX( 1.e-10, ABS(ff_t(ji,jj)) * zhnu )) & 
    247241               &      + 1._wp / ( 2 * zxsiN * zetastar ) - 1._wp / vkarmn 
    248                ! 
    249                ! compute gammats 
    250                pgt(ji,jj) = zustar(ji,jj) / (zgturb + zgmolet) 
    251                pgs(ji,jj) = zustar(ji,jj) / (zgturb + zgmoles) 
    252             END IF 
    253          END DO 
    254       END DO 
     242            ! 
     243            ! compute gammats 
     244            pgt(ji,jj) = zustar(ji,jj) / (zgturb + zgmolet) 
     245            pgs(ji,jj) = zustar(ji,jj) / (zgturb + zgmoles) 
     246         END IF 
     247      END_2D 
     248      ! output ustar 
     249      CALL iom_put('isfustar',zustar(:,:)) 
    255250 
    256251   END SUBROUTINE gammats_vel_stab 

  • NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/OCE/ISF/isfcpl.F90

    r15062 r15122  
    201201            ENDIF 
    202202         END_2D 
     203         CALL lbc_lnk( 'isfcpl', ssh(:,:,Kmm), 'T', 1.0_wp, zssmask_b(:,:), 'T', 1.0_wp ) 
    203204         ! 
    204205         zssh(:,:) = ssh(:,:,Kmm) 
    205206         zssmask0(:,:) = zssmask_b(:,:) 
    206207         ! 
    207          CALL lbc_lnk( 'iscplrst', zssh, 'T', 1.0_wp, zssmask0, 'T', 1.0_wp ) 
    208208         ! 
    209209      END DO 
    … …  
    359359         END DO 
    360360         ! 
     361         CALL lbc_lnk( 'isfcpl', ts(:,:,:,jp_tem,Kmm), 'T', 1.0_wp, ts(:,:,:,jp_sal,Kmm), 'T', 1.0_wp, ztmask1, 'T', 1.0_wp) 
     362         ! 
    361363         ! update temperature and salinity and mask 
    362364         zts0(:,:,:,:)  = ts(:,:,:,:,Kmm) 
    363365         ztmask0(:,:,:) = ztmask1(:,:,:) 
    364366         ! 
    365          CALL lbc_lnk( 'iscplrst', zts0(:,:,:,jp_tem), 'T', 1.0_wp, zts0(:,:,:,jp_sal), 'T', 1.0_wp, ztmask0, 'T', 1.0_wp) 
    366367         ! 
    367368      END DO  ! nn_drown 
    … …  
    437438               &    - e1v(ji  ,jj-1) * e3v(ji  ,jj-1,jk,Kmm) * vv(ji  ,jj-1,jk,Kmm)  ) & 
    438439               &               * tmask(ji,jj,jk) 
     440            ! 
     441            ! 1.3: get 3d volume flux difference (before - after cpl) (>0 out) 
     442            !      correction to add is _b - _n 
     443            risfcpl_vol(ji,jj,jk) = zqvolb(ji,jj,jk) - zqvoln(ji,jj,jk) 
    439444         END_2D 
    440          ! 
    441          ! 1.3: get 3d volume flux difference (before - after cpl) (>0 out) 
    442          !      correction to add is _b - _n 
    443          risfcpl_vol(:,:,jk) = zqvolb(:,:,jk) - zqvoln(:,:,jk) 
    444445      END DO 
    445446      ! 
    … …  
    455456      END_2D 
    456457      ! 
    457       CALL lbc_lnk( 'iscpl', risfcpl_vol, 'T', 1.0_wp ) 
     458      CALL lbc_lnk( 'isfcpl', risfcpl_vol, 'T', 1.0_wp ) 
    458459      ! 
    459460      ! 3.0: set total correction (div, tr(:,:,:,:,Krhs), ssh) 
    … …  
    691692      ! 
    692693      ! add lbclnk 
    693       CALL lbc_lnk( 'iscplrst', risfcpl_cons_tsc(:,:,:,jp_tem), 'T', 1.0_wp, risfcpl_cons_tsc(:,:,:,jp_sal), 'T', 1.0_wp, & 
    694          &                      risfcpl_cons_vol(:,:,:)       , 'T', 1.0_wp) 
     694      CALL lbc_lnk( 'isfcpl', risfcpl_cons_tsc(:,:,:,jp_tem), 'T', 1.0_wp, risfcpl_cons_tsc(:,:,:,jp_sal), 'T', 1.0_wp, & 
     695         &                    risfcpl_cons_vol(:,:,:)       , 'T', 1.0_wp) 
    695696      ! 
    696697      ! ssh correction (for dynspg_ts) 

  • NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/OCE/ISF/isfpar.F90

    r15004 r15122  
    3030   USE iom            ! I/O library 
    3131   USE fldread        ! read input field at current time step 
    32    USE lbclnk         ! lbc_lnk 
    3332 
    3433   IMPLICIT NONE 
    … …  
    3736   PUBLIC   isf_par, isf_par_init 
    3837 
     38   !! * Substitutions    
     39#  include "do_loop_substitute.h90" 
    3940   !!---------------------------------------------------------------------- 
    4041   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    6768      INTEGER, INTENT(in) ::   Kmm                                    ! ocean time level index 
    6869      !!--------------------------------------------------------------------- 
     70      INTEGER ::   ji, jj 
    6971      REAL(wp), DIMENSION(jpi,jpj) :: zqoce, zqhc, zqlat, zqh 
    7072      !!--------------------------------------------------------------------- 
    … …  
    7375      CALL isfpar_mlt( kt, Kmm, zqhc, zqoce, pqfwf  ) 
    7476      ! 
    75       ! compute heat and water flux (from isf to oce) 
    76       pqfwf(:,:) = pqfwf(:,:) * mskisf_par(:,:) 
    77       zqoce(:,:) = zqoce(:,:) * mskisf_par(:,:) 
    78       zqhc (:,:) = zqhc(:,:)  * mskisf_par(:,:) 
    79       ! 
    80       ! compute latent heat flux (from isf to oce) 
    81       zqlat(:,:) = - pqfwf(:,:) * rLfusisf    ! 2d latent heat flux (W/m2) 
    82       ! 
    83       ! total heat flux (from isf to oce) 
    84       zqh(:,:) = ( zqhc (:,:) + zqoce(:,:) ) 
    85       ! 
    86       ! lbclnk on melt and heat fluxes 
    87       CALL lbc_lnk( 'isfmlt', zqh, 'T', 1.0_wp, pqfwf, 'T', 1.0_wp) 
     77      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
     78         ! compute heat and water flux (from isf to oce) 
     79         pqfwf(ji,jj) = pqfwf(ji,jj) * mskisf_par(ji,jj) 
     80         zqoce(ji,jj) = zqoce(ji,jj) * mskisf_par(ji,jj) 
     81         zqhc (ji,jj) = zqhc(ji,jj)  * mskisf_par(ji,jj) 
     82         ! 
     83         ! compute latent heat flux (from isf to oce) 
     84         zqlat(ji,jj) = - pqfwf(ji,jj) * rLfusisf    ! 2d latent heat flux (W/m2) 
     85         ! 
     86         ! total heat flux (from isf to oce) 
     87         zqh(ji,jj) = ( zqhc (ji,jj) + zqoce(ji,jj) ) 
     88         ! 
     89         ! set temperature content 
     90         ptsc(ji,jj,jp_tem) = zqh(ji,jj) * r1_rho0_rcp 
     91      END_2D 
    8892      ! 
    8993      ! output fluxes 
    9094      CALL isf_diags_flx( Kmm, misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par, 'par', pqfwf, zqoce, zqlat, zqhc) 
    91       ! 
    92       ! set temperature content 
    93       ptsc(:,:,jp_tem) = zqh(:,:) * r1_rho0_rcp 
    9495      ! 
    9596      ! write restart variables (qoceisf, qhcisf, fwfisf for now and before) 

  • NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/OCE/LDF/ldftra.F90

    r15095 r15122  
    615615            DO jk = 1, jpkm1 
    616616               aeiu(:,:,jk) = aeiu(:,:,jk) * umask(:,:,jk) 
    617                ahtv(:,:,jk) = ahtv(:,:,jk) * vmask(:,:,jk) 
     617               aeiv(:,:,jk) = aeiv(:,:,jk) * vmask(:,:,jk) 
    618618            END DO 
    619619         ENDIF 
    … …  
    755755               CALL ctl_stop('ldf_eiv: Unrecognised option for nn_ldfeiv_shape.')          
    756756      END SELECT 
    757       CALL lbc_lnk( 'ldftra', zaeiw(:,:), 'W', 1.0_wp )       ! lateral boundary condition 
    758       ! 
    759       DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     757      IF( nn_hls == 1 )   CALL lbc_lnk( 'ldftra', zaeiw(:,:), 'W', 1.0_wp )   ! lateral boundary condition 
     758      ! 
     759      DO_2D( 0, 0, 0, 0 ) 
    760760         paeiu(ji,jj,1) = 0.5_wp * ( zaeiw(ji,jj) + zaeiw(ji+1,jj  ) ) * umask(ji,jj,1) 
    761761         paeiv(ji,jj,1) = 0.5_wp * ( zaeiw(ji,jj) + zaeiw(ji  ,jj+1) ) * vmask(ji,jj,1) 

  • NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/OCE/SBC/sbcblk_algo_ice_an05.F90

    r14072 r15122  
    267267 
    268268            !! *** TABLE 1 of Andreas et al. 2005 *** 
    269             !! Smooth flow condition (R* <= 0.135): 
    270             zsmoot = 0.5_wp + SIGN( 0.5_wp, (0.135_wp   - zre) ) ! zre <= 0.135: zsmoot==1 ; otherwize: zsmoot==0 
    271             !! Transition (0.135 < R* < 2.5): 
    272             ztrans = 0.5_wp + SIGN( 0.5_wp, (2.49999_wp - zre) ) - zsmoot 
    273             !! Rough ( R* > 2.5): 
    274             zrough = 0.5_wp + SIGN( 0.5_wp, (zre - 2.5_wp) ) 
    275  
    276             IF( (zsmoot+ztrans+zrough > 1.001_wp).OR.(zsmoot+ztrans+zrough < 0.999_wp) ) & 
    277                CALL ctl_stop( ' rough_leng_tq@mod_blk_ice_an05.f90 => something wrong with zsmoot, ztrans, zrough!' ) 
    278  
     269            zsmoot = 0._wp ; ztrans = 0._wp ; zrough = 0._wp 
     270            IF    ( zre <= 0.135_wp ) THEN   ! Smooth flow condition (R* <= 0.135): 
     271               zsmoot = 1._wp 
     272            ELSEIF( zre < 2.5_wp )    THEN   ! Transition (0.135 < R* < 2.5) 
     273               ztrans = 1._wp 
     274            ELSE                             ! Rough ( R* > 2.5) 
     275               zrough = 1._wp 
     276            ENDIF 
     277                
    279278            zlog  = LOG(zre) 
    280279            zlog2 = zlog*zlog 

  • NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/OCE/SBC/sbcblk_algo_ice_cdn.F90

    r14072 r15122  
    3535   !!============================================================ 
    3636   REAL(wp), PARAMETER ::   rce10_i_0 = 3.46e-3_wp ! (Eq.48) MIZ 
    37  
    3837   REAL(wp), PARAMETER ::   ralpha_0  = 0.2_wp     ! (Eq.12) (ECHAM6 value) 
    3938 
    … …  
    6160      !! 
    6261      !!---------------------------------------------------------------------- 
    63       REAL(wp), DIMENSION(jpi,jpj)                       :: CdN10_f_LU12  ! neutral FORM drag coefficient contribution over sea-ice 
    64       REAL(wp), DIMENSION(jpi,jpj), INTENT(in)           :: pfrice ! ice concentration [fraction]  => at_i_b  ! NOT USED if pSc, phf and pDi all provided... 
    65       REAL(wp), DIMENSION(jpi,jpj), INTENT(in)           :: pz0w   ! roughness length over water  [m] 
    66       REAL(wp), DIMENSION(jpi,jpj), INTENT(in), OPTIONAL :: pSc    ! shletering function [0-1] (Sc->1 for large distance between floes, ->0 for small distances) 
    67       REAL(wp), DIMENSION(jpi,jpj), INTENT(in), OPTIONAL :: phf    ! mean freeboard of floes    [m] 
    68       REAL(wp), DIMENSION(jpi,jpj), INTENT(in), OPTIONAL :: pDi    ! cross wind dimension of the floe (aka effective edge length for form drag)   [m] 
    69       !!---------------------------------------------------------------------- 
    70       LOGICAL :: l_known_Sc=.FALSE., l_known_hf=.FALSE., l_known_Di=.FALSE. 
    71       REAL(wp) :: ztmp, zrlog, zfri, zfrw, zSc, zhf, zDi 
    72       INTEGER  :: ji, jj 
     62      REAL(wp), DIMENSION(jpi,jpj)                       ::   CdN10_f_LU12  ! neutral FORM drag coefficient contribution over sea-ice 
     63      REAL(wp), DIMENSION(jpi,jpj), INTENT(in)           ::   pfrice ! ice concentration [fraction]  => at_i_b  ! NOT USED if pSc, phf and pDi all provided... 
     64      REAL(wp), DIMENSION(jpi,jpj), INTENT(in)           ::   pz0w   ! roughness length over water  [m] 
     65      REAL(wp), DIMENSION(jpi,jpj), INTENT(in), OPTIONAL ::   pSc    ! shletering function [0-1] (Sc->1 for large distance between floes, ->0 for small distances) 
     66      REAL(wp), DIMENSION(jpi,jpj), INTENT(in), OPTIONAL ::   phf    ! mean freeboard of floes    [m] 
     67      REAL(wp), DIMENSION(jpi,jpj), INTENT(in), OPTIONAL ::   pDi    ! cross wind dimension of the floe (aka effective edge length for form drag)   [m] 
     68      !!---------------------------------------------------------------------- 
     69      LOGICAL  ::  l_known_Sc=.FALSE., l_known_hf=.FALSE., l_known_Di=.FALSE. 
     70      REAL(wp) ::   ztmp, zrlog, zfri, zfrw, zSc, zhf, zDi 
     71      INTEGER  ::   ji, jj 
    7372      !!---------------------------------------------------------------------- 
    7473      l_known_Sc    = PRESENT(pSc) 
    … …  
    7877      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    7978             
    80             zfri = pfrice(ji,jj) 
    81             zfrw = (1._wp - zfri) 
    82  
    83             IF(l_known_Sc) THEN 
    84                zSc = pSc(ji,jj) 
    85             ELSE 
    86                !! Sc parameterized in terms of A (ice fraction): 
    87                zSc = zfrw**(1._wp / ( 10._wp * rBeta_0 ))   ! Eq.(31) 
    88             END IF 
    89  
    90             IF(l_known_hf) THEN 
    91                zhf = phf(ji,jj) 
    92             ELSE 
    93                !! hf parameterized in terms of A (ice fraction): 
    94                zhf = rhmax_0*zfri + rhmin_0*zfrw  ! Eq.(25) 
    95             END IF 
    96  
    97             IF(l_known_Di) THEN 
    98                zDi = pDi(ji,jj) 
    99             ELSE 
    100                !! Di parameterized in terms of A (ice fraction): 
    101                ztmp = 1._wp / ( 1._wp - (rDmin_0/rDmax_0)**(1._wp/rBeta_0) )   ! A* Eq.(27) 
    102                zDi =  rDmin_0 * ( ztmp/(ztmp - zfri) )**rBeta_0                !    Eq.(26) 
    103             END IF 
    104  
    105             ztmp  = 1._wp/pz0w(ji,jj) 
    106             zrlog = LOG(zhf*ztmp) / LOG(10._wp*ztmp) 
    107  
    108             CdN10_f_LU12(:,:) = 0.5_wp* 0.3_wp * zrlog*zrlog * zSc*zSc * zhf/zDi * zfri  ! Eq.(22) 
    109             !!                   1/2      Ce 
     79         zfri = pfrice(ji,jj) 
     80         zfrw = (1._wp - zfri) 
     81          
     82         IF(l_known_Sc) THEN 
     83            zSc = pSc(ji,jj) 
     84         ELSE 
     85            !! Sc parameterized in terms of A (ice fraction): 
     86            zSc = zfrw**(1._wp / ( 10._wp * rBeta_0 ))   ! Eq.(31) 
     87         END IF 
     88          
     89         IF(l_known_hf) THEN 
     90            zhf = phf(ji,jj) 
     91         ELSE 
     92            !! hf parameterized in terms of A (ice fraction): 
     93            zhf = rhmax_0*zfri + rhmin_0*zfrw  ! Eq.(25) 
     94         END IF 
     95          
     96         IF(l_known_Di) THEN 
     97            zDi = pDi(ji,jj) 
     98         ELSE 
     99            !! Di parameterized in terms of A (ice fraction): 
     100            ztmp = 1._wp / ( 1._wp - (rDmin_0/rDmax_0)**(1._wp/rBeta_0) )   ! A* Eq.(27) 
     101            zDi =  rDmin_0 * ( ztmp/(ztmp - zfri) )**rBeta_0                !    Eq.(26) 
     102         END IF 
     103          
     104         ztmp  = 1._wp/pz0w(ji,jj) 
     105         zrlog = LOG(zhf*ztmp) / LOG(10._wp*ztmp) 
     106 
     107         CdN10_f_LU12(ji,jj) = 0.5_wp* 0.3_wp * zrlog*zrlog * zSc*zSc * zhf/zDi * zfri  ! Eq.(22) 
     108         !!                    1/2      Ce 
    110109 
    111110      END_2D 
    … …  
    114113    
    115114   FUNCTION CdN_f_LU12_eq36( pzu, pfrice ) 
    116       REAL(wp), DIMENSION(jpi,jpj)             :: CdN_f_LU12_eq36 ! neutral FORM drag coefficient contribution over sea-ice 
    117       REAL(wp),                     INTENT(in) :: pzu    ! reference height                       [m] 
    118       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pfrice ! ice concentration [fraction]  => at_i_b  ! NOT USED if pSc, phf and pDi all provided... 
     115      !!---------------------------------------------------------------------- 
     116      REAL(wp), DIMENSION(jpi,jpj)             ::   CdN_f_LU12_eq36 ! neutral FORM drag coefficient contribution over sea-ice 
     117      REAL(wp),                     INTENT(in) ::   pzu    ! reference height                       [m] 
     118      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pfrice ! ice concentration [fraction]  => at_i_b  ! NOT USED if pSc, phf and pDi all provided... 
    119119      !!---------------------------------------------------------------------- 
    120120      REAL(wp) :: ztmp, zrlog, zfri, zhf, zDi 
    … …  
    129129 
    130130      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    131  
    132             zfri = pfrice(ji,jj) 
    133  
    134             CdN_f_LU12_eq36(:,:) = 0.5_wp* 0.3_wp * zrlog*zrlog * zhf/zDi  * (1._wp - zfri)**rBeta_0 ! Eq.(35) & (36) 
    135             !!                        1/2      Ce 
     131         zfri = pfrice(ji,jj) 
     132         CdN_f_LU12_eq36(ji,jj) = 0.5_wp* 0.3_wp * zrlog*zrlog * zhf/zDi  * (1._wp - zfri)**rBeta_0 ! Eq.(35) & (36) 
     133         !!                       1/2      Ce 
    136134      END_2D 
    137135   END FUNCTION CdN_f_LU12_eq36 
    138  
    139  
    140136 
    141137 
    … …  
    172168      !! 
    173169      !!---------------------------------------------------------------------- 
    174       REAL(wp), DIMENSION(jpi,jpj)              :: CdN10_f_LU13  ! neutral FORM drag coefficient contribution over sea-ice 
    175       REAL(wp), DIMENSION(jpi,jpj), INTENT(in)  :: pfrice           ! ice concentration [fraction]  => at_i_b 
    176  
    177       !!---------------------------------------------------------------------- 
    178       REAL(wp)            ::   zcoef 
     170      REAL(wp), DIMENSION(jpi,jpj)              ::   CdN10_f_LU13  ! neutral FORM drag coefficient contribution over sea-ice 
     171      REAL(wp), DIMENSION(jpi,jpj), INTENT(in)  ::   pfrice           ! ice concentration [fraction]  => at_i_b 
     172      !!---------------------------------------------------------------------- 
     173      INTEGER  ::   ji, jj 
     174      REAL(wp) ::   zcoef 
    179175      !!---------------------------------------------------------------------- 
    180176      zcoef = rNu_0 + 1._wp / ( 10._wp * rBeta_0 ) 
    … …  
    183179      !!  => so we keep only the last rhs terms of Eq.(1) of Lupkes et al, 2013 that we divide by "A": 
    184180      !! (we multiply Cd_i_s and Cd_i_f by A later, when applying ocean-ice partitioning... 
    185  
    186       CdN10_f_LU13(:,:) = rCe_0 * pfrice(:,:)**(rMu_0 - 1._wp) * (1._wp - pfrice(:,:))**zcoef 
     181      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
     182         CdN10_f_LU13(ji,jj) = rCe_0 * pfrice(ji,jj)**(rMu_0 - 1._wp) * (1._wp - pfrice(ji,jj))**zcoef 
     183      END_2D 
    187184      !! => seems okay for winter 100% sea-ice as second rhs term vanishes as pfrice == 1.... 
    188185 
    … …  
    207204      !! 
    208205      !!---------------------------------------------------------------------- 
    209       REAL(wp), DIMENSION(jpi,jpj)                       :: CdN_f_LG15  ! neutral FORM drag coefficient contribution over sea-ice 
    210       REAL(wp),                     INTENT(in )          :: pzu    ! reference height                       [m] 
    211       REAL(wp), DIMENSION(jpi,jpj), INTENT(in)           :: pfrice ! ice concentration [fraction]  => at_i_b  ! NOT USED if pSc, phf and pDi all provided... 
    212       REAL(wp), DIMENSION(jpi,jpj), INTENT(in)           :: pz0i   ! roughness length over ICE  [m] (in LU12, it's over water ???) 
    213       REAL(wp), DIMENSION(jpi,jpj), INTENT(in), OPTIONAL :: pSc    ! shletering function [0-1] (Sc->1 for large distance between floes, ->0 for small distances) 
    214       REAL(wp), DIMENSION(jpi,jpj), INTENT(in), OPTIONAL :: phf    ! mean freeboard of floes    [m] 
    215       REAL(wp), DIMENSION(jpi,jpj), INTENT(in), OPTIONAL :: pDi    ! cross wind dimension of the floe (aka effective edge length for form drag)   [m] 
    216       !!---------------------------------------------------------------------- 
    217       LOGICAL :: l_known_Sc=.FALSE., l_known_hf=.FALSE., l_known_Di=.FALSE. 
    218       REAL(wp) :: ztmp, zrlog, zfri, zfrw, zSc, zhf, zDi 
    219       INTEGER  :: ji, jj 
     206      REAL(wp), DIMENSION(jpi,jpj)                       ::   CdN_f_LG15  ! neutral FORM drag coefficient contribution over sea-ice 
     207      REAL(wp),                     INTENT(in )          ::   pzu    ! reference height                       [m] 
     208      REAL(wp), DIMENSION(jpi,jpj), INTENT(in)           ::   pfrice ! ice concentration [fraction]  => at_i_b  ! NOT USED if pSc, phf and pDi all provided... 
     209      REAL(wp), DIMENSION(jpi,jpj), INTENT(in)           ::   pz0i   ! roughness length over ICE  [m] (in LU12, it's over water ???) 
     210      REAL(wp), DIMENSION(jpi,jpj), INTENT(in), OPTIONAL ::   pSc    ! shletering function [0-1] (Sc->1 for large distance between floes, ->0 for small distances) 
     211      REAL(wp), DIMENSION(jpi,jpj), INTENT(in), OPTIONAL ::   phf    ! mean freeboard of floes    [m] 
     212      REAL(wp), DIMENSION(jpi,jpj), INTENT(in), OPTIONAL ::   pDi    ! cross wind dimension of the floe (aka effective edge length for form drag)   [m] 
     213      !!---------------------------------------------------------------------- 
     214      LOGICAL  ::  l_known_Sc=.FALSE., l_known_hf=.FALSE., l_known_Di=.FALSE. 
     215      REAL(wp) ::   ztmp, zrlog, zfri, zfrw, zSc, zhf, zDi 
     216      INTEGER  ::   ji, jj 
    220217      !!---------------------------------------------------------------------- 
    221218      l_known_Sc    = PRESENT(pSc) 
    … …  
    225222      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    226223 
    227             zfri = pfrice(ji,jj) 
    228             zfrw = (1._wp - zfri) 
    229  
    230             IF(l_known_Sc) THEN 
    231                zSc = pSc(ji,jj) 
    232             ELSE 
    233                !! Sc parameterized in terms of A (ice fraction): 
    234                zSc = zfrw**(1._wp / ( 10._wp * rBeta_0 ))   ! Eq.(31) 
    235             END IF 
    236  
    237             IF(l_known_hf) THEN 
    238                zhf = phf(ji,jj) 
    239             ELSE 
    240                !! hf parameterized in terms of A (ice fraction): 
    241                zhf = rhmax_0*zfri + rhmin_0*zfrw  ! Eq.(25) 
    242             END IF 
    243  
    244             IF(l_known_Di) THEN 
    245                zDi = pDi(ji,jj) 
    246             ELSE 
    247                !! Di parameterized in terms of A (ice fraction): 
    248                ztmp = 1._wp / ( 1._wp - (rDmin_0/rDmax_0)**(1._wp/rBeta_0) )   ! A* Eq.(27) 
    249                zDi =  rDmin_0 * ( ztmp/(ztmp - zfri) )**rBeta_0                !    Eq.(26) 
    250             END IF 
    251  
    252             ztmp  = 1._wp/pz0i(ji,jj) 
    253             zrlog = LOG(zhf*ztmp/2.718_wp) / LOG(pzu*ztmp)  !LOLO: adding number "e" !!! 
    254  
    255             CdN_f_LG15(:,:) = 0.5_wp* 0.4_wp * zrlog*zrlog * zSc*zSc * zhf/zDi * zfri  ! Eq.(21) Lukes & Gryanik (2015) 
    256             !!                   1/2      Ce 
    257  
     224         zfri = pfrice(ji,jj) 
     225         zfrw = (1._wp - zfri) 
     226          
     227         IF(l_known_Sc) THEN 
     228            zSc = pSc(ji,jj) 
     229         ELSE 
     230            !! Sc parameterized in terms of A (ice fraction): 
     231            zSc = zfrw**(1._wp / ( 10._wp * rBeta_0 ))   ! Eq.(31) 
     232         END IF 
     233          
     234         IF(l_known_hf) THEN 
     235            zhf = phf(ji,jj) 
     236         ELSE 
     237            !! hf parameterized in terms of A (ice fraction): 
     238            zhf = rhmax_0*zfri + rhmin_0*zfrw  ! Eq.(25) 
     239         END IF 
     240          
     241         IF(l_known_Di) THEN 
     242            zDi = pDi(ji,jj) 
     243         ELSE 
     244            !! Di parameterized in terms of A (ice fraction): 
     245            ztmp = 1._wp / ( 1._wp - (rDmin_0/rDmax_0)**(1._wp/rBeta_0) )   ! A* Eq.(27) 
     246            zDi =  rDmin_0 * ( ztmp/(ztmp - zfri) )**rBeta_0                !    Eq.(26) 
     247         END IF 
     248          
     249         ztmp  = 1._wp/pz0i(ji,jj) 
     250         zrlog = LOG(zhf*ztmp/2.718_wp) / LOG(pzu*ztmp)  !LOLO: adding number "e" !!! 
     251          
     252         CdN_f_LG15(ji,jj) = 0.5_wp* 0.4_wp * zrlog*zrlog * zSc*zSc * zhf/zDi * zfri  ! Eq.(21) Lukes & Gryanik (2015) 
     253         !!                   1/2      Ce 
     254          
    258255      END_2D 
    259256   END FUNCTION CdN_f_LG15 
    260257 
    261258 
    262  
    263259   FUNCTION CdN_f_LG15_light( pzu, pfrice, pz0w ) 
    264260      !!---------------------------------------------------------------------- 
    … …  
    275271      !! 
    276272      !!---------------------------------------------------------------------- 
    277       REAL(wp), DIMENSION(jpi,jpj)             :: CdN_f_LG15_light  ! neutral FORM drag coefficient contribution over sea-ice 
    278       REAL(wp),                     INTENT(in) :: pzu    ! reference height [m] 
    279       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pfrice ! ice concentration [fraction]  => at_i_b 
    280       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pz0w   ! roughness length over water  [m] 
    281       !!---------------------------------------------------------------------- 
    282       REAL(wp) :: ztmp, zrlog, zfri 
    283       INTEGER  :: ji, jj 
    284       !!---------------------------------------------------------------------- 
    285       DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    286  
    287             zfri = pfrice(ji,jj) 
    288  
    289             ztmp = 1._wp / pz0w(ji,jj) 
    290             zrlog = LOG( 10._wp * ztmp ) / LOG( pzu * ztmp ) ! part of (Eq.46) 
    291  
    292             CdN_f_LG15_light(:,:) = rce10_i_0 *zrlog*zrlog * zfri * (1._wp - zfri)**rbeta_0  ! (Eq.46)  [ index 1 is for ice, 2 for water ] 
     273      REAL(wp), DIMENSION(jpi,jpj)             ::   CdN_f_LG15_light  ! neutral FORM drag coefficient contribution over sea-ice 
     274      REAL(wp),                     INTENT(in) ::   pzu    ! reference height [m] 
     275      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pfrice ! ice concentration [fraction]  => at_i_b 
     276      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pz0w   ! roughness length over water  [m] 
     277      !!---------------------------------------------------------------------- 
     278      REAL(wp) ::   ztmp, zrlog, zfri 
     279      INTEGER  ::   ji, jj 
     280      !!---------------------------------------------------------------------- 
     281      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
     282 
     283         zfri = pfrice(ji,jj) 
     284          
     285         ztmp = 1._wp / pz0w(ji,jj) 
     286         zrlog = LOG( 10._wp * ztmp ) / LOG( pzu * ztmp ) ! part of (Eq.46) 
     287          
     288         CdN_f_LG15_light(ji,jj) = rce10_i_0 *zrlog*zrlog * zfri * (1._wp - zfri)**rbeta_0  ! (Eq.46)  [ index 1 is for ice, 2 for water ] 
    293289 
    294290      END_2D 
    295291   END FUNCTION CdN_f_LG15_light 
    296  
    297292 
    298293 

  • NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/OCE/ZDF/zdfmxl.F90

    r15095 r15122  
    493493      ! w-level of the turbocline and mixing layer (iom_use) 
    494494      imld(:,:) = mbkt(A2D(nn_hls)) + 1                ! Initialization to the number of w ocean point 
    495       DO_3DS( 1, 1, 1, 1, jpkm1, nlb10, -1 )   ! from the bottom to nlb10 
     495      DO_3DS( nn_hls, nn_hls, nn_hls, nn_hls, jpkm1, nlb10, -1 )   ! from the bottom to nlb10 
    496496         IF( avt (ji,jj,jk) < avt_c * wmask(ji,jj,jk) )   imld(ji,jj) = jk      ! Turbocline 
    497497      END_3D 
    498498      ! depth of the mixing layer 
    499       DO_2D_OVR( 1, 1, 1, 1 ) 
     499      DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls ) 
    500500         iik = imld(ji,jj) 
    501501         hmld (ji,jj) = gdepw(ji,jj,iik  ,Kmm) * ssmask(ji,jj)    ! Turbocline depth 

  • NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/OFF/dtadyn.F90

    r15023 r15122  
    419419      gdepw(:,:,1,Kmm) = 0.0_wp 
    420420      ! 
    421       DO_3D( 1, 1, 1, 1, 2, jpk ) 
     421      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 2, jpk ) 
    422422         zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) 
    423423         gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm) 
    … …  
    503503         ! 
    504504         nk_rnf(:,:) = 0                               ! set the number of level over which river runoffs are applied 
    505          DO_2D( 1, 1, 1, 1 ) 
     505         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    506506            IF( h_rnf(ji,jj) > 0._wp ) THEN 
    507507               jk = 2 
    … …  
    517517         END_2D 
    518518         ! 
    519          DO_2D( 1, 1, 1, 1 )                           ! set the associated depth 
     519         ! set the associated depth 
     520         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    520521            h_rnf(ji,jj) = 0._wp 
    521522            DO jk = 1, nk_rnf(ji,jj) 
    … …  
    552553      !!---------------------------------------------------------------------- 
    553554      ! 
    554       DO_2D( 1, 1, 1, 1 )               ! update the depth over which runoffs are distributed 
     555      !  update the depth over which runoffs are distributed 
     556      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    555557         h_rnf(ji,jj) = 0._wp 
    556558         DO jk = 1, nk_rnf(ji,jj)                           ! recalculates h_rnf to be the depth in metres 

  • NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/C14/trcsms_c14.F90

    r13970 r15122  
    8181      ! ------------------------------------------------------------------- 
    8282 
    83       DO_2D( 1, 1, 1, 1 ) 
     83      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    8484         IF( tmask(ji,jj,1) >  0. ) THEN 
    8585            ! 
    … …  
    128128      ! 
    129129      ! Add the surface flux to the trend of jp_c14 
    130       DO_2D( 1, 1, 1, 1 ) 
     130      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    131131         tr(ji,jj,1,jp_c14,Krhs) = tr(ji,jj,1,jp_c14,Krhs) + qtr_c14(ji,jj) / e3t(ji,jj,1,Kmm)  
    132132      END_2D 
    133133      ! 
    134134      ! Computation of decay effects on jp_c14 
    135       DO_3D( 1, 1, 1, 1, 1, jpk ) 
     135      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) 
    136136         ! 
    137137         tr(ji,jj,jk,jp_c14,Krhs) = tr(ji,jj,jk,jp_c14,Krhs) - rlam14 * tr(ji,jj,jk,jp_c14,Kbb) * tmask(ji,jj,jk)  

  • NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/C14/trcwri_c14.F90

    r14239 r15122  
    6060         zz3d(:,:,:) = 0._wp 
    6161         ! 
    62          DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     62         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 
    6363            IF( tmask(ji,jj,jk) > 0._wp) THEN 
    6464               z3d (ji,jj,jk) = tr(ji,jj,jk,jp_c14,Kmm) 
    … …  
    7171         z2d(:,:) =0._wp 
    7272         jk = 1 
    73          DO_2D( 1, 1, 1, 1 ) 
     73         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    7474            ztemp = zres(ji,jj) / c14sbc(ji,jj) 
    7575            IF( ztemp > 0._wp .AND. tmask(ji,jj,jk) > 0._wp ) z2d(ji,jj) = LOG( ztemp ) 

  • NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/CFC/trcini_cfc.F90

    r13295 r15122  
    132132      !--------------------------------------------------------------------------------------- 
    133133      zyd = ylatn - ylats       
    134       DO_2D( 1, 1, 1, 1 ) 
     134      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    135135         IF(     gphit(ji,jj) >= ylatn ) THEN   ;   xphem(ji,jj) = 1.e0 
    136136         ELSEIF( gphit(ji,jj) <= ylats ) THEN   ;   xphem(ji,jj) = 0.e0 

  • NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/CFC/trcsms_cfc.F90

    r13497 r15122  
    126126          
    127127         !                                                         !------------! 
    128          DO_2D( 1, 1, 1, 1 )                                       !  i-j loop  ! 
     128         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )                   !  i-j loop  ! 
    129129            !                                                      !------------! 
    130130            ! space interpolation 

  • NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/PISCES/P2Z/p2zexp.F90

    r13295 r15122  
    121121      ELSE 
    122122        ! 
    123         DO_2D( 1, 1, 1, 1 ) 
     123        DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    124124           zsedpocd = zsedpoca(ji,jj) - 2. * sedpocn(ji,jj) + sedpocb(ji,jj)      ! time laplacian on tracers 
    125125           sedpocb(ji,jj) = sedpocn(ji,jj) + rn_atfp * zsedpocd                     ! sedpocb <-- filtered sedpocn 
    … …  
    174174      zdm0 = 0._wp 
    175175      zrro = 1._wp 
    176       DO_3D( 1, 1, 1, 1, jpkb, jpkm1 ) 
     176      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, jpkb, jpkm1 ) 
    177177         zfluo = ( gdepw(ji,jj,jk  ,Kmm) / gdepw(ji,jj,jpkb,Kmm) )**xhr 
    178178         zfluu = ( gdepw(ji,jj,jk+1,Kmm) / gdepw(ji,jj,jpkb,Kmm) )**xhr 
    … …  
    191191      dminl(:,:)   = 0._wp 
    192192      dmin3(:,:,:) = zdm0 
    193       DO_3D( 1, 1, 1, 1, 1, jpk ) 
     193      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) 
    194194         IF( tmask(ji,jj,jk) == 0._wp ) THEN 
    195195            dminl(ji,jj) = dminl(ji,jj) + dmin3(ji,jj,jk) 
    … …  
    198198      END_3D 
    199199 
    200       DO_2D( 1, 1, 1, 1 ) 
     200      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    201201         IF( tmask(ji,jj,1) == 0 )   dmin3(ji,jj,1) = 0._wp 
    202202      END_2D 

  • NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/PISCES/P2Z/p2zopt.F90

    r13497 r15122  
    9595      !                                          ! Photosynthetically Available Radiation (PAR) 
    9696      zcoef = 12 * redf / rcchl / rpig           ! -------------------------------------- 
    97       DO_3D( 1, 1, 1, 1, 2, jpk )                     ! local par at w-levels 
     97      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 2, jpk ) 
    9898         zpig = LOG(  MAX( TINY(0.), tr(ji,jj,jk-1,jpphy,Kmm) ) * zcoef  ) 
    9999         zkr  = xkr0 + xkrp * EXP( xlr * zpig ) 
    … …  
    102102         zparg(ji,jj,jk) = zparg(ji,jj,jk-1) * EXP( -zkg * e3t(ji,jj,jk-1,Kmm) ) 
    103103      END_3D 
    104       DO_3D( 1, 1, 1, 1, 1, jpkm1 )                  ! mean par at t-levels 
     104      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) ! mean par at t-levels 
    105105         zpig = LOG(  MAX( TINY(0.), tr(ji,jj,jk,jpphy,Kmm) ) * zcoef  ) 
    106106         zkr  = xkr0 + xkrp * EXP( xlr * zpig ) 
    … …  
    114114      !                                          ! -------------- 
    115115      neln(:,:) = 1                                   ! euphotic layer level 
    116       DO_3D( 1, 1, 1, 1, 1, jpkm1 )                   ! (i.e. 1rst T-level strictly below EL bottom) 
     116      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )  ! (i.e. 1rst T-level strictly below EL bottom) 
    117117        IF( etot(ji,jj,jk) >= zpar100(ji,jj) )   neln(ji,jj) = jk + 1  
    118118      END_3D 
    119119      !                                               ! Euphotic layer depth 
    120       DO_2D( 1, 1, 1, 1 ) 
     120      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )  
    121121         heup(ji,jj) = gdepw(ji,jj,neln(ji,jj),Kmm) 
    122122      END_2D 

  • NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/PISCES/P2Z/p2zsed.F90

    r13295 r15122  
    8989 
    9090      ! tracer flux divergence at t-point added to the general trend 
    91       DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     91      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )  
    9292         ztra(ji,jj,jk)  = - ( zwork(ji,jj,jk) - zwork(ji,jj,jk+1) ) / e3t(ji,jj,jk,Kmm) 
    9393         tr(ji,jj,jk,jpdet,Krhs) = tr(ji,jj,jk,jpdet,Krhs) + ztra(ji,jj,jk)  

  • NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/PISCES/P4Z/p4zagg.F90

    r13295 r15122  
    6060      IF( ln_p4z ) THEN 
    6161         ! 
    62          DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     62         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 
    6363            ! 
    6464            zfact = xstep * xdiss(ji,jj,jk) 
    … …  
    102102      ELSE    ! ln_p5z 
    103103        ! 
    104          DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     104         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 
    105105            ! 
    106106            zfact = xstep * xdiss(ji,jj,jk) 

  • NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/PISCES/P4Z/p4zbc.F90

    r13295 r15122  
    112112      IF( ll_river ) THEN 
    113113          jl = n_trc_indcbc(jpno3) 
    114           DO_2D( 1, 1, 1, 1 ) 
     114          DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    115115             DO jk = 1, nk_rnf(ji,jj) 
    116116                zcoef = rn_rfact / ( e1e2t(ji,jj) * h_rnf(ji,jj) * rn_cbc_time ) * tmask(ji,jj,1) 
    … …  
    145145         ALLOCATE( zironice(jpi,jpj) ) 
    146146         ! 
    147          DO_2D( 1, 1, 1, 1 ) 
     147         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    148148            zdep    = rfact / e3t(ji,jj,1,Kmm) 
    149149            zwflux  = fmmflx(ji,jj) / 1000._wp 
    … …  
    313313         CALL lbc_lnk( 'p4zbc', zcmask , 'T', 1.0_wp )      ! lateral boundary conditions on cmask   (sign unchanged) 
    314314         ! 
    315          DO_3D( 1, 1, 1, 1, 1, jpk ) 
     315         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) 
    316316            zexpide   = MIN( 8.,( gdept(ji,jj,jk,Kmm) / 500. )**(-1.5) ) 
    317317            zdenitide = -0.9543 + 0.7662 * LOG( zexpide ) - 0.235 * LOG( zexpide )**2 

  • NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/PISCES/P4Z/p4zbio.F90

    r13295 r15122  
    7272      xdiss(:,:,:) = 1. 
    7373!!gm the use of nmld should be better here? 
    74       DO_3D( 1, 1, 1, 1, 2, jpkm1 ) 
     74      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 2, jpkm1 ) 
    7575!!gm  :  use nmln  and test on jk ...  less memory acces 
    7676         IF( gdepw(ji,jj,jk+1,Kmm) > hmld(ji,jj) )   xdiss(ji,jj,jk) = 0.01 

  • NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/PISCES/P4Z/p4zche.F90

    r14086 r15122  
    179179      ! 0.04°C relative to an exact computation 
    180180      ! --------------------------------------------------------------------- 
    181       DO_3D( 1, 1, 1, 1, 1, jpk ) 
     181      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) 
    182182         zpres = gdept(ji,jj,jk,Kmm) / 1000. 
    183183         za1 = 0.04 * ( 1.0 + 0.185 * ts(ji,jj,jk,jp_tem,Kmm) + 0.035 * (salinprac(ji,jj,jk) - 35.0) ) 
    … …  
    188188      ! CHEMICAL CONSTANTS - SURFACE LAYER 
    189189      ! ---------------------------------- 
    190       DO_2D( 1, 1, 1, 1 ) 
     190      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    191191         !                             ! SET ABSOLUTE TEMPERATURE 
    192192         ztkel = tempis(ji,jj,1) + 273.15 
    … …  
    204204      ! OXYGEN SOLUBILITY - DEEP OCEAN 
    205205      ! ------------------------------- 
    206       DO_3D( 1, 1, 1, 1, 1, jpk ) 
     206      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) 
    207207         ztkel = tempis(ji,jj,jk) + 273.15 
    208208         zsal  = salinprac(ji,jj,jk) + ( 1.- tmask(ji,jj,jk) ) * 35. 
    … …  
    223223      ! CHEMICAL CONSTANTS - DEEP OCEAN 
    224224      ! ------------------------------- 
    225       DO_3D( 1, 1, 1, 1, 1, jpk ) 
     225      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) 
    226226          ! SET PRESSION ACCORDING TO SAUNDER (1980) 
    227227          zplat   = SIN ( ABS(gphit(ji,jj)*3.141592654/180.) ) 
    … …  
    451451      IF( ln_timing )  CALL timing_start('ahini_for_at') 
    452452      ! 
    453       DO_3D( 1, 1, 1, 1, 1, jpk ) 
     453      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) 
    454454      p_alkcb  = tr(ji,jj,jk,jptal,Kbb) * 1000. / (rhop(ji,jj,jk) + rtrn) 
    455455      p_dictot = tr(ji,jj,jk,jpdic,Kbb) * 1000. / (rhop(ji,jj,jk) + rtrn) 
    … …  
    549549 
    550550   ! TOTAL H+ scale: conversion factor for Htot = aphscale * Hfree 
    551    DO_3D( 1, 1, 1, 1, 1, jpk ) 
     551   DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) 
    552552      IF (rmask(ji,jj,jk) == 1.) THEN 
    553553         p_alktot = tr(ji,jj,jk,jptal,Kbb) * 1000. / (rhop(ji,jj,jk) + rtrn) 
    … …  
    578578 
    579579   DO jn = 1, jp_maxniter_atgen  
    580    DO_3D( 1, 1, 1, 1, 1, jpk ) 
     580      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) 
    581581      IF (rmask(ji,jj,jk) == 1.) THEN 
    582582         zfact = rhop(ji,jj,jk) / 1000. + rtrn 

  • NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/PISCES/P4Z/p4zfechem.F90

    r13472 r15122  
    9292      ! Chemistry is supposed to be fast enough to be at equilibrium 
    9393      ! ------------------------------------------------------------ 
    94       DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     94      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 
    9595         zTL1(ji,jj,jk)  = ztotlig(ji,jj,jk) 
    9696         zkeq            = fekeq(ji,jj,jk) 
    … …  
    107107 
    108108      zdust = 0.         ! if no dust available 
    109       DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     109      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 
    110110         ! Scavenging rate of iron. This scavenging rate depends on the load of particles of sea water.  
    111111         ! This parameterization assumes a simple second order kinetics (k[Particles][Fe]). 
    … …  
    173173      IF( ln_ligand ) THEN 
    174174         ! 
    175          DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     175         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 
    176176            zlam1a   = ( 0.369  * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) + 102.4  * tr(ji,jj,jk,jppoc,Kbb) ) * xdiss(ji,jj,jk)    & 
    177177                &    + ( 114.   * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) ) 

  • NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/PISCES/P4Z/p4zflx.F90

    r13295 r15122  
    110110      IF( l_co2cpl )   satmco2(:,:) = atm_co2(:,:) 
    111111 
    112       DO_2D( 1, 1, 1, 1 ) 
     112      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    113113         ! DUMMY VARIABLES FOR DIC, H+, AND BORATE 
    114114         zfact = rhop(ji,jj,1) / 1000. + rtrn 
    … …  
    126126      ! ------------------------------------------- 
    127127 
    128       DO_2D( 1, 1, 1, 1 ) 
     128      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    129129         ztc  = MIN( 35., ts(ji,jj,1,jp_tem,Kmm) ) 
    130130         ztc2 = ztc * ztc 
    … …  
    145145 
    146146 
    147       DO_2D( 1, 1, 1, 1 ) 
     147      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    148148         ztkel = tempis(ji,jj,1) + 273.15 
    149149         zsal  = salinprac(ji,jj,1) + ( 1.- tmask(ji,jj,1) ) * 35. 

  • NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/PISCES/P4Z/p4zint.F90

    r14086 r15122  
    5050      ! Computation of the silicon dependant half saturation  constant for silica uptake 
    5151      ! --------------------------------------------------- 
    52       DO_2D( 1, 1, 1, 1 ) 
     52      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    5353         zvar = tr(ji,jj,1,jpsil,Kbb) * tr(ji,jj,1,jpsil,Kbb) 
    5454         xksimax(ji,jj) = MAX( xksimax(ji,jj), ( 1.+ 7.* zvar / ( xksilim * xksilim + zvar ) ) * 1e-6 ) 

  • NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/PISCES/P4Z/p4zligand.F90

    r13295 r15122  
    5252      IF( ln_timing )   CALL timing_start('p4z_ligand') 
    5353      ! 
    54       DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     54      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 
    5555         ! 
    5656         ! ------------------------------------------------------------------ 

  • NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/PISCES/P4Z/p4zlim.F90

    r13434 r15122  
    9898      IF( ln_timing )   CALL timing_start('p4z_lim') 
    9999      ! 
    100       DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     100      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 
    101101          
    102102         ! Tuning of the iron concentration to a minimum level that is set to the detection limit 
    … …  
    173173      ! Compute the fraction of nanophytoplankton that is made of calcifiers 
    174174      ! -------------------------------------------------------------------- 
    175       DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     175      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 
    176176         zlim1 =  ( tr(ji,jj,jk,jpno3,Kbb) * concnnh4 + tr(ji,jj,jk,jpnh4,Kbb) * concnno3 )    & 
    177177            &   / ( concnno3 * concnnh4 + concnnh4 * tr(ji,jj,jk,jpno3,Kbb) + concnno3 * tr(ji,jj,jk,jpnh4,Kbb) )  
    … …  
    193193      END_3D 
    194194      ! 
    195       DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     195      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 
    196196         ! denitrification factor computed from O2 levels 
    197197         nitrfac(ji,jj,jk) = MAX(  0.e0, 0.4 * ( 6.e-6  - tr(ji,jj,jk,jpoxy,Kbb) )    & 

  • NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/PISCES/P4Z/p4zlys.F90

    r13295 r15122  
    7474 
    7575      CALL solve_at_general( zhinit, zhi, Kbb ) 
    76  
    77       DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     76      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 
    7877         zco3(ji,jj,jk) = tr(ji,jj,jk,jpdic,Kbb) * ak13(ji,jj,jk) * ak23(ji,jj,jk) / (zhi(ji,jj,jk)**2   & 
    7978            &             + ak13(ji,jj,jk) * zhi(ji,jj,jk) + ak13(ji,jj,jk) * ak23(ji,jj,jk) + rtrn ) 
    … …  
    8786      !     --------------------------------------------------------- 
    8887 
    89       DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     88      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 
    9089 
    9190         ! DEVIATION OF [CO3--] FROM SATURATION VALUE 

  • NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/PISCES/P4Z/p4zmeso.F90

    r13295 r15122  
    8181      IF( ln_timing )   CALL timing_start('p4z_meso') 
    8282      ! 
    83       DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     83      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 
    8484         zcompam   = MAX( ( tr(ji,jj,jk,jpmes,Kbb) - 1.e-9 ), 0.e0 ) 
    8585         zfact     = xstep * tgfunc2(ji,jj,jk) * zcompam 

  • NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/PISCES/P4Z/p4zmicro.F90

    r13295 r15122  
    7979      IF( ln_timing )   CALL timing_start('p4z_micro') 
    8080      ! 
    81       DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     81      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 
    8282         zcompaz = MAX( ( tr(ji,jj,jk,jpzoo,Kbb) - 1.e-9 ), 0.e0 ) 
    8383         zfact   = xstep * tgfunc2(ji,jj,jk) * zcompaz 

  • NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/PISCES/P4Z/p4zmort.F90

    r13295 r15122  
    7777      ! 
    7878      prodcal(:,:,:) = 0._wp   ! calcite production variable set to zero 
    79       DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     79      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 
    8080         zcompaph = MAX( ( tr(ji,jj,jk,jpphy,Kbb) - 1e-8 ), 0.e0 ) 
    8181         !     When highly limited by macronutrients, very small cells  
    … …  
    152152      !     ------------------------------------------------------------ 
    153153 
    154       DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     154      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 
    155155 
    156156         zcompadi = MAX( ( tr(ji,jj,jk,jpdia,Kbb) - 1e-9), 0. ) 

  • NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/PISCES/P4Z/p4zopt.F90

    r14213 r15122  
    8585      IF( ln_p5z )   zchl3d(:,:,:) = zchl3d(:,:,:)    + tr(:,:,:,jppch,Kbb) 
    8686      ! 
    87       DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     87      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 
    8888         zchl = ( zchl3d(ji,jj,jk) + rtrn ) * 1.e6 
    8989         zchl = MIN(  10. , MAX( 0.05, zchl )  ) 
    … …  
    156156      heup_01(:,:) = gdepw(:,:,2,Kmm) 
    157157 
    158       DO_3D( 1, 1, 1, 1, 2, nksr ) 
     158      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 2, nksr) 
    159159        IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >=  zqsr100(ji,jj) )  THEN 
    160160           neln(ji,jj) = jk+1                    ! Euphotic level : 1rst T-level strictly below Euphotic layer 
    … …  
    174174      zetmp2 (:,:)   = 0.e0 
    175175 
    176       DO_3D( 1, 1, 1, 1, 1, nksr ) 
     176      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, nksr) 
    177177         IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN 
    178178            zetmp1 (ji,jj) = zetmp1 (ji,jj) + etot     (ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! remineralisation 
    … …  
    185185      zpar(:,:,:) = etot_ndcy(:,:,:)  ! diagnostic : PAR with no diurnal cycle  
    186186      ! 
    187       DO_3D( 1, 1, 1, 1, 1, nksr ) 
     187      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, nksr) 
    188188         IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN 
    189189            z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) 
    … …  
    197197      zetmp4 (:,:)   = 0.e0 
    198198      ! 
    199       DO_3D( 1, 1, 1, 1, 1, nksr ) 
     199      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, nksr) 
    200200         IF( gdepw(ji,jj,jk+1,Kmm) <= MIN(hmld(ji,jj), heup_01(ji,jj)) ) THEN 
    201201            zetmp3 (ji,jj) = zetmp3 (ji,jj) + enano    (ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! production 
    … …  
    207207      ediatm(:,:,:) = ediat(:,:,:) 
    208208      ! 
    209       DO_3D( 1, 1, 1, 1, 1, nksr ) 
     209      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, nksr) 
    210210         IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN 
    211211            z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) 
    … …  
    217217      IF( ln_p5z ) THEN 
    218218         ALLOCATE( zetmp5(jpi,jpj) )  ;   zetmp5 (:,:) = 0.e0 
    219          DO_3D( 1, 1, 1, 1, 1, nksr ) 
     219         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, nksr) 
    220220            IF( gdepw(ji,jj,jk+1,Kmm) <= MIN(hmld(ji,jj), heup_01(ji,jj)) ) THEN 
    221221               zetmp5(ji,jj)  = zetmp5 (ji,jj) + epico(ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! production 
    … …  
    225225         epicom(:,:,:) = epico(:,:,:) 
    226226         ! 
    227          DO_3D( 1, 1, 1, 1, 1, nksr ) 
     227         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, nksr) 
    228228            IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN 
    229229               z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) 
    … …  
    300300        pe3(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekr(:,:,1) ) 
    301301        ! 
    302         DO_3D( 1, 1, 1, 1, 2, nksr ) 
     302        DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 2, nksr) 
    303303           pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -0.5 * ( ekb(ji,jj,jk-1) + ekb(ji,jj,jk) ) ) 
    304304           pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -0.5 * ( ekg(ji,jj,jk-1) + ekg(ji,jj,jk) ) ) 

  • NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/PISCES/P4Z/p4zpoc.F90

    r13295 r15122  
    107107     ! ----------------------------------------------------------------------- 
    108108     ztremint(:,:,:) = zremigoc(:,:,:) 
    109      DO_3D( 1, 1, 1, 1, 2, jpkm1 ) 
     109     DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 
    110110        IF (tmask(ji,jj,jk) == 1.) THEN 
    111111          zdep = hmld(ji,jj) 
    … …  
    192192 
    193193      IF( ln_p4z ) THEN 
    194          DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     194         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 
    195195            ! POC disaggregation by turbulence and bacterial activity.  
    196196            ! -------------------------------------------------------- 
    … …  
    212212         END_3D 
    213213      ELSE 
    214          DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     214         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 
    215215             ! POC disaggregation by turbulence and bacterial activity.  
    216216            ! -------------------------------------------------------- 
    … …  
    260260     ! ---------------------------------------------------------------- 
    261261     !  
    262      DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     262     DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 
    263263        zdep = hmld(ji,jj) 
    264264        IF (tmask(ji,jj,jk) == 1. .AND. gdept(ji,jj,jk,Kmm) <= zdep ) THEN 
    … …  
    275275     ! --------------------------------------------------------------------- 
    276276     ztremint(:,:,:) = zremipoc(:,:,:) 
    277      DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     277     DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 
    278278        IF (tmask(ji,jj,jk) == 1.) THEN 
    279279          zdep = hmld(ji,jj) 
    … …  
    310310     ! ----------------------------------------------------------------------- 
    311311     ! 
    312      DO_3D( 1, 1, 1, 1, 2, jpkm1 ) 
     312     DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 2, jpkm1) 
    313313        IF (tmask(ji,jj,jk) == 1.) THEN 
    314314          zdep = hmld(ji,jj) 
    … …  
    384384 
    385385     IF( ln_p4z ) THEN 
    386          DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     386         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 
    387387            IF (tmask(ji,jj,jk) == 1.) THEN 
    388388              ! POC disaggregation by turbulence and bacterial activity.  
    … …  
    401401         END_3D 
    402402     ELSE 
    403        DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     403       DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 
    404404          ! POC disaggregation by turbulence and bacterial activity.  
    405405          ! -------------------------------------------------------- 

  • NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/PISCES/P4Z/p4zprod.F90

    r13295 r15122  
    110110      ! day length in hours 
    111111      zstrn(:,:) = 0. 
    112       DO_2D( 1, 1, 1, 1 ) 
     112      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    113113         zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rad ) 
    114114         zargu = MAX( -1., MIN(  1., zargu ) ) 
    … …  
    117117 
    118118      ! Impact of the day duration and light intermittency on phytoplankton growth 
    119       DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     119      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 
    120120         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    121121            zval = MAX( 1., zstrn(ji,jj) ) 
    … …  
    135135 
    136136      ! Computation of the P-I slope for nanos and diatoms 
    137       DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     137      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 
    138138         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    139139            ztn         = MAX( 0., ts(ji,jj,jk,jp_tem,Kmm) - 15. ) 
    … …  
    150150      END_3D 
    151151 
    152       DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     152      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 
    153153         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    154154             ! Computation of production function for Carbon 
    … …  
    171171      !  Computation of a proxy of the N/C ratio 
    172172      !  --------------------------------------- 
    173       DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     173      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 
    174174          zval = MIN( xnanopo4(ji,jj,jk), ( xnanonh4(ji,jj,jk) + xnanono3(ji,jj,jk) ) )   & 
    175175          &      * zprmaxn(ji,jj,jk) / ( zprbio(ji,jj,jk) + rtrn ) 
    … …  
    181181 
    182182 
    183       DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     183      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 
    184184 
    185185          IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    … …  
    205205      !  Sea-ice effect on production 
    206206 
    207       DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     207      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 
    208208         zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 
    209209         zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 
    … …  
    211211 
    212212      ! Computation of the various production terms  
    213       DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     213      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 
    214214         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    215215            !  production terms for nanophyto. (C) 
    … …  
    237237 
    238238      ! Computation of the chlorophyll production terms 
    239       DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     239      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 
    240240         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    241241            !  production terms for nanophyto. ( chlorophyll ) 
    … …  
    260260 
    261261      !   Update the arrays TRA which contain the biological sources and sinks 
    262       DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     262      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 
    263263        IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    264264           zproreg  = zprorcan(ji,jj,jk) - zpronewn(ji,jj,jk) 
    … …  
    288288     IF( ln_ligand ) THEN 
    289289         zpligprod1(:,:,:) = 0._wp    ;    zpligprod2(:,:,:) = 0._wp 
    290          DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     290         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 
    291291           IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    292292              zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) 

  • NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/PISCES/P4Z/p4zrem.F90

    r13295 r15122  
    8989      ! that was modeling explicitely bacteria 
    9090      ! ------------------------------------------------------- 
    91       DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     91      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 
    9292         zdep = MAX( hmld(ji,jj), heup(ji,jj) ) 
    9393         IF( gdept(ji,jj,jk,Kmm) < zdep ) THEN 
    … …  
    103103 
    104104      IF( ln_p4z ) THEN 
    105          DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     105         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 
    106106            ! DOC ammonification. Depends on depth, phytoplankton biomass 
    107107            ! and a limitation term which is supposed to be a parameterization of the bacterial activity.  
    … …  
    134134         END_3D 
    135135      ELSE 
    136          DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     136         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 
    137137            ! DOC ammonification. Depends on depth, phytoplankton biomass 
    138138            ! and a limitation term which is supposed to be a parameterization of the bacterial activity.  
    … …  
    178178 
    179179 
    180       DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     180      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 
    181181         ! NH4 nitrification to NO3. Ceased for oxygen concentrations 
    182182         ! below 2 umol/L. Inhibited at strong light  
    … …  
    200200       ENDIF 
    201201 
    202       DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     202      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 
    203203 
    204204         ! Bacterial uptake of iron. No iron is available in DOC. So 
    … …  
    226226      ! --------------------------------------------------------------- 
    227227 
    228       DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     228      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 
    229229         zdep     = MAX( hmld(ji,jj), heup_01(ji,jj) ) 
    230230         zsatur   = MAX( rtrn, ( sio3eq(ji,jj,jk) - tr(ji,jj,jk,jpsil,Kbb) ) / ( sio3eq(ji,jj,jk) + rtrn ) ) 

  • NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/PISCES/P4Z/p4zsed.F90

    r13546 r15122  
    9494         ! OA: Warning, the following part is necessary to avoid CFL problems above the sediments 
    9595         ! -------------------------------------------------------------------- 
    96          DO_2D( 1, 1, 1, 1 ) 
     96         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    9797            ikt  = mbkt(ji,jj) 
    9898            zdep = e3t(ji,jj,ikt,Kmm) / xstep 
    … …  
    104104         ! Computation of the fraction of organic matter that is permanently buried from Dunne's model 
    105105         ! ------------------------------------------------------- 
    106          DO_2D( 1, 1, 1, 1 ) 
     106         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    107107           IF( tmask(ji,jj,1) == 1 ) THEN 
    108108              ikt = mbkt(ji,jj) 
    … …  
    130130      IF( .NOT.lk_sed )  zrivsil = 1._wp - sedsilfrac 
    131131 
    132       DO_2D( 1, 1, 1, 1 ) 
     132      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    133133         ikt  = mbkt(ji,jj) 
    134134         zdep = xstep / e3t(ji,jj,ikt,Kmm)  
    … …  
    142142      ! 
    143143      IF( .NOT.lk_sed ) THEN 
    144          DO_2D( 1, 1, 1, 1 ) 
     144         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    145145            ikt  = mbkt(ji,jj) 
    146146            zdep = xstep / e3t(ji,jj,ikt,Kmm)  
    … …  
    160160      ENDIF 
    161161      ! 
    162       DO_2D( 1, 1, 1, 1 ) 
     162      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    163163         ikt  = mbkt(ji,jj) 
    164164         zdep = xstep / e3t(ji,jj,ikt,Kmm)  
    … …  
    172172      ! 
    173173      IF( ln_p5z ) THEN 
    174          DO_2D( 1, 1, 1, 1 ) 
     174         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    175175            ikt  = mbkt(ji,jj) 
    176176            zdep = xstep / e3t(ji,jj,ikt,Kmm)  
    … …  
    187187         ! The 0.5 factor in zpdenit is to avoid negative NO3 concentration after 
    188188         ! denitrification in the sediments. Not very clever, but simpliest option. 
    189          DO_2D( 1, 1, 1, 1 ) 
     189         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    190190            ikt  = mbkt(ji,jj) 
    191191            zdep = xstep / e3t(ji,jj,ikt,Kmm)  
    … …  
    224224      ENDDO 
    225225      IF( ln_p4z ) THEN 
    226          DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     226         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 
    227227            !                      ! Potential nitrogen fixation dependant on temperature and iron 
    228228            ztemp = ts(ji,jj,jk,jp_tem,Kmm) 
    … …  
    240240         END_3D 
    241241      ELSE       ! p5z 
    242          DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     242         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 
    243243            !                      ! Potential nitrogen fixation dependant on temperature and iron 
    244244            ztemp = ts(ji,jj,jk,jp_tem,Kmm) 
    … …  
    261261      ! ---------------------------------------- 
    262262      IF( ln_p4z ) THEN 
    263          DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     263         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 
    264264            zfact = nitrpot(ji,jj,jk) * nitrfix 
    265265            tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zfact / 3.0 
    … …  
    278278         END_3D 
    279279      ELSE    ! p5z 
    280          DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     280         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 
    281281            zfact = nitrpot(ji,jj,jk) * nitrfix 
    282282            tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zfact / 3.0 

  • NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/PISCES/P4Z/p4zsink.F90

    r13295 r15122  
    8181      !    by data and from the coagulation theory 
    8282      !    ----------------------------------------------------------- 
    83       DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     83      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 
    8484         zmax  = MAX( heup_01(ji,jj), hmld(ji,jj) ) 
    8585         zfact = MAX( 0., gdepw(ji,jj,jk+1,Kmm) - zmax ) / wsbio2scale 

  • NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/PISCES/P4Z/p4zsms.F90

    r15023 r15122  
    130130         xnegtr(:,:,:) = 1.e0 
    131131         DO jn = jp_pcs0, jp_pcs1 
    132             DO_3D( 1, 1, 1, 1, 1, jpk ) 
     132            DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk) 
    133133               IF( ( tr(ji,jj,jk,jn,Kbb) + tr(ji,jj,jk,jn,Krhs) ) < 0.e0 ) THEN 
    134134                  ztra             = ABS( tr(ji,jj,jk,jn,Kbb) ) / ( ABS( tr(ji,jj,jk,jn,Krhs) ) + rtrn ) 

  • NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/PISCES/P4Z/p5zlim.F90

    r13434 r15122  
    131131      zratchl = 6.0 
    132132      ! 
    133       DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     133      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 
    134134         !  
    135135         ! Tuning of the iron concentration to a minimum level that is set to the detection limit 
    … …  
    318318      ! phytoplankton (see Daines et al., 2013).  
    319319      ! -------------------------------------------------------------------------------------------------- 
    320       DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     320      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 
    321321         ! Size estimation of nanophytoplankton 
    322322         ! ------------------------------------ 
    … …  
    367367      ! Compute the fraction of nanophytoplankton that is made of calcifiers 
    368368      ! -------------------------------------------------------------------- 
    369       DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     369      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 
    370370         zlim1 =  tr(ji,jj,jk,jpnh4,Kbb) / ( tr(ji,jj,jk,jpnh4,Kbb) + concnnh4 ) + tr(ji,jj,jk,jpno3,Kbb)    & 
    371371         &        / ( tr(ji,jj,jk,jpno3,Kbb) + concnno3 ) * ( 1.0 - tr(ji,jj,jk,jpnh4,Kbb)   & 
    … …  
    385385      END_3D 
    386386      ! 
    387       DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     387      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 
    388388         ! denitrification factor computed from O2 levels 
    389389         nitrfac(ji,jj,jk) = MAX(  0.e0, 0.4 * ( 6.e-6  - tr(ji,jj,jk,jpoxy,Kbb) )    & 

  • NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/PISCES/P4Z/p5zmeso.F90

    r13295 r15122  
    9898      IF ( bmetexc2 ) zmetexcess = 1.0 
    9999 
    100       DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     100      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 
    101101         zcompam   = MAX( ( tr(ji,jj,jk,jpmes,Kbb) - 1.e-9 ), 0.e0 ) 
    102102         zfact     = xstep * tgfunc2(ji,jj,jk) * zcompam 

  • NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/PISCES/P4Z/p5zmicro.F90

    r13295 r15122  
    9696      IF ( bmetexc ) zmetexcess = 1.0 
    9797      ! 
    98       DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     98      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 
    9999         zcompaz = MAX( ( tr(ji,jj,jk,jpzoo,Kbb) - 1.e-9 ), 0.e0 ) 
    100100         zfact   = xstep * tgfunc2(ji,jj,jk) * zcompaz 

  • NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/PISCES/P4Z/p5zmort.F90

    r13295 r15122  
    8282      ! 
    8383      prodcal(:,:,:) = 0.  !: calcite production variable set to zero 
    84       DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     84      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 
    8585         zcompaph = MAX( ( tr(ji,jj,jk,jpphy,Kbb) - 1e-9 ), 0.e0 ) 
    8686         !   Squared mortality of Phyto similar to a sedimentation term during 
    … …  
    148148      IF( ln_timing )   CALL timing_start('p5z_pico') 
    149149      ! 
    150       DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     150      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 
    151151         zcompaph = MAX( ( tr(ji,jj,jk,jppic,Kbb) - 1e-9 ), 0.e0 ) 
    152152         !  Squared mortality of Phyto similar to a sedimentation term during 
    … …  
    207207      ! 
    208208 
    209       DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     209      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 
    210210 
    211211         zcompadi = MAX( ( tr(ji,jj,jk,jpdia,Kbb) - 1E-9), 0. ) 

  • NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/PISCES/P4Z/p5zprod.F90

    r13295 r15122  
    125125      ! day length in hours 
    126126      zstrn(:,:) = 0. 
    127       DO_2D( 1, 1, 1, 1 ) 
     127      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    128128         zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rad ) 
    129129         zargu = MAX( -1., MIN(  1., zargu ) ) 
    … …  
    132132 
    133133         ! Impact of the day duration on phytoplankton growth 
    134       DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     134      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 
    135135         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    136136            zval = MAX( 1., zstrn(ji,jj) ) 
    … …  
    152152      WHERE( zstrn(:,:) < 1.e0 ) zstrn(:,:) = 24. 
    153153 
    154       DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     154      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 
    155155         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    156156            ! Computation of the P-I slope for nanos and diatoms 
    … …  
    186186      END_3D 
    187187 
    188       DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     188      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 
    189189 
    190190          IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    … …  
    208208 
    209209      !  Sea-ice effect on production                                                                                
    210       DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     210      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 
    211211         zprbio(ji,jj,jk)  = zprbio(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 
    212212         zprpic(ji,jj,jk)  = zprpic(ji,jj,jk) * ( 1. - fr_i(ji,jj) )  
    … …  
    216216 
    217217      ! Computation of the various production terms of nanophytoplankton  
    218       DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     218      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 
    219219         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    220220            !  production terms for nanophyto. 
    … …  
    249249 
    250250      ! Computation of the various production terms of picophytoplankton  
    251       DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     251      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 
    252252         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    253253            !  production terms for picophyto. 
    … …  
    282282 
    283283      ! Computation of the various production terms of diatoms 
    284       DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     284      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 
    285285         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    286286            !  production terms for diatomees 
    … …  
    316316      END_3D 
    317317 
    318       DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     318      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 
    319319         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    320320               !  production terms for nanophyto. ( chlorophyll ) 
    … …  
    347347 
    348348      !   Update the arrays TRA which contain the biological sources and sinks 
    349       DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     349      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 
    350350        zprontot = zpronewn(ji,jj,jk) + zproregn(ji,jj,jk) 
    351351        zproptot = zpronewp(ji,jj,jk) + zproregp(ji,jj,jk) 
    … …  
    410410     IF( ln_ligand ) THEN 
    411411         zpligprod1(:,:,:) = 0._wp    ;    zpligprod2(:,:,:) = 0._wp              
    412          DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     412         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 
    413413           zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) + excretp * zprorcap(ji,jj,jk) 
    414414           zfeup    = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) + texcretp * zprofep(ji,jj,jk) 

  • NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/PISCES/trcwri_pisces.F90

    r14239 r15122  
    6969            zo2min   (:,:) = tr(:,:,1,jpoxy,Kmm) * tmask(:,:,1) 
    7070            zdepo2min(:,:) = gdepw(:,:,1,Kmm)   * tmask(:,:,1) 
    71             DO_3D( 1, 1, 1, 1, 2, jpkm1 ) 
     71            DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 2, jpkm1 )  
    7272               IF( tmask(ji,jj,jk) == 1 ) then 
    7373                  IF( tr(ji,jj,jk,jpoxy,Kmm) < zo2min(ji,jj) ) then 

  • NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/TRP/trcatf.F90

    r14172 r15122  
    239239      ENDIF 
    240240      ! 
    241       DO jn = 1, jptra       
    242          DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     241      DO jn = 1, jptra   
     242         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )     
    243243            ze3t_b = 1._wp + r3t(ji,jj,Kbb) * tmask(ji,jj,jk) 
    244244            ze3t_n = 1._wp + r3t(ji,jj,Kmm) * tmask(ji,jj,jk) 
    … …  
    313313      ! 
    314314      DO jn = 1, jptra       
    315          DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     315         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )     
    316316            ze3t_b = e3t(ji,jj,jk,Kbb) 
    317317            ze3t_n = e3t(ji,jj,jk,Kmm) 

  • NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/TRP/trcsink.F90

    r13295 r15122  
    7474         iiter(:,:) = 1 
    7575      ELSE 
    76          DO_2D( 1, 1, 1, 1 ) 
     76         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    7777            iiter(ji,jj) = 1 
    7878            DO jk = 1, jpkm1 
    … …  
    8686      ENDIF 
    8787 
    88       DO_3D( 1, 1, 1, 1, 1,jpkm1 ) 
     88      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 
    8989         IF( tmask(ji,jj,jk) == 1.0 ) THEN 
    9090           zwsmax = 0.5 * e3t(ji,jj,jk,Kmm) * rday / rsfact 
    … …  
    146146      DO jn = 1, 2 
    147147         !  first guess of the slopes interior values 
    148          DO_2D( 1, 1, 1, 1 ) 
     148         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    149149            ! 
    150150            zstep = rsfact / REAL( kiter(ji,jj), wp ) / 2. 
    … …  
    186186      END DO 
    187187 
    188       DO_3D( 1, 1, 1, 1, 1,jpkm1 ) 
     188      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 
    189189         zflx = ( psinkflx(ji,jj,jk) - psinkflx(ji,jj,jk+1) ) / e3t(ji,jj,jk,Kmm) 
    190190         ztrb(ji,jj,jk) = ztrb(ji,jj,jk) + 2. * zflx 

  • NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/TRP/trdmxl_trc.F90

    r14433 r15122  
    124124            isum  = 0   ;   zvlmsk(:,:) = 0.e0 
    125125 
    126             IF( jpktrd_trc < jpk ) THEN                           ! description ??? 
    127                DO_2D( 1, 1, 1, 1 ) 
     126            IF( jpktrd_trc < jpk ) THEN    
     127               DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )  
    128128                  IF( nmld_trc(ji,jj) <= jpktrd_trc ) THEN 
    129129                     zvlmsk(ji,jj) = tmask(ji,jj,1) 
    … …  
    148148         ! ... Weights for vertical averaging 
    149149         wkx_trc(:,:,:) = 0.e0 
    150          DO_3D( 1, 1, 1, 1, 1, jpktrd_trc )                       ! initialize wkx_trc with vertical scale factor in mixed-layer 
     150         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpktrd_trc )                    ! description ??? 
    151151            IF( jk - nmld_trc(ji,jj) < 0 )   wkx_trc(ji,jj,jk) = e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) 
    152152         END_3D 
    … …  
    259259         ! 
    260260         DO jn = 1, jptra 
    261             DO_2D( 1, 1, 1, 1 ) 
     261            DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )                    ! description ??? 
    262262               ik = nmld_trc(ji,jj) 
    263263               IF( ln_trdtrc(jn) )    & 

  • NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/TRP/trdmxl_trc_rst.F90

    r13286 r15122  
    1212   USE iom             ! I/O module 
    1313   USE trc             ! for ctrcnm 
    14    USE trdmxl_trc_oce  ! for lk_trdmxl_trc 
     14   USE trdtrc_oce  ! for lk_trdmxl_trc 
    1515 
    1616   IMPLICIT NONE 
    … …  
    5353         clpath = TRIM(cn_trcrst_outdir) 
    5454         IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/' 
    55          IF(lwp) WRITE(numout,*) '             open ocean restart_mld_trc NetCDF  'TRIM(clpath)//TRIM(clname) 
     55         IF(lwp) WRITE(numout,*) '             open ocean restart_mld_trc NetCDF  ', TRIM(clpath)//TRIM(clname) 
    5656         CALL iom_open( TRIM(clpath)//TRIM(clname), nummldw_trc, ldwrt = .TRUE. ) 
    5757      ENDIF 

  • NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/trcais.F90

    r15004 r15122  
    170170               IF( ln_trc_ais(jn) ) THEN 
    171171                  jl = n_trc_indais(jn) 
    172                   DO_2D( 1, 1, 1, 1 ) 
     172                  DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    173173                     zfact = 1. / e3t(ji,jj,1,Kmm) 
    174174                     ptr(ji,jj,jk,jn,Krhs) = ptr(ji,jj,1,jn,Krhs) + fwficb(ji,jj) * r1_rho0 * ptr(ji,jj,1,jn,Kmm) * zfact 
    … …  
    182182               IF( ln_trc_ais(jn) ) THEN 
    183183                  jl = n_trc_indais(jn) 
    184                   DO_2D( 1, 1, 1, 1 ) 
     184                  DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    185185                     IF( ln_isfpar_mlt ) THEN 
    186186                        zcalv = fwfisf_par(ji,jj) * r1_rho0 / rhisf_tbl_par(ji,jj) 
    … …  
    214214               IF( ln_trc_ais(jn) ) THEN 
    215215                  jl = n_trc_indais(jn) 
    216                   DO_2D( 1, 1, 1, 1 ) 
     216                  DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    217217                     DO jk = 1, icblev 
    218218                        zcalv  =  fwficb(ji,jj) * r1_rho0  
    … …  
    229229               IF( ln_trc_ais(jn) ) THEN 
    230230                  jl = n_trc_indais(jn) 
    231                   DO_2D( 1, 1, 1, 1 ) 
     231                  DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    232232                     IF( ln_isfpar_mlt ) THEN 
    233233                        zcalv = - fwfisf_par(ji,jj) * r1_rho0 / rhisf_tbl_par(ji,jj) 

  • NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/trcopt.F90

    r14558 r15122  
    8686      !     Attenuation coef. function of Chlorophyll and wavelength (RGB) 
    8787      !     -------------------------------------------------------------- 
    88       DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     88      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 
    8989         ztmp = ( zchl(ji,jj,jk) + rtrn ) * 1.e6 
    9090         ztmp = MIN(  10. , MAX( 0.05, ztmp )  ) 
    … …  
    108108         ! 
    109109         DO jk = 2, nksrp + 1 
    110             DO_2D(1, 1, 1, 1) 
     110            DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    111111                  ze0(ji,jj,jk) = ze0(ji,jj,jk-1) * EXP( -e3t(ji,jj,jk-1,Kmm) * (1. / rn_si0) ) 
    112112                  ze1(ji,jj,jk) = ze1(ji,jj,jk-1) * EXP( -ekb  (ji,jj,jk-1 )        ) 
    … …  
    147147      !     Weighted broadband attenuation coefficient 
    148148      !     ------------------------------------------ 
    149       DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     149      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 
    150150         ztmp = ze1(ji,jj,jk)* ekb(ji,jj,jk) + ze2(ji,jj,jk) * ekg(ji,jj,jk) + ze3(ji,jj,jk) * ekr(ji,jj,jk) 
    151151         xeps(ji,jj,jk) = ztmp / e3t(ji,jj,jk,Kmm) / (etot(ji,jj,jk) + rtrn) 
    … …  
    163163      heup_01(:,:) = gdepw(:,:,2,Kmm) 
    164164      ! 
    165       DO_3D( 1, 1, 1, 1, 2, nksrp ) 
     165      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 2, nksrp ) 
    166166        IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >=  zqsr100(ji,jj) )  THEN 
    167167           ! Euphotic level (1st T-level strictly below Euphotic layer) 
    … …  
    214214         pe3(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekr(:,:,1) ) 
    215215         ! 
    216          DO_3D( 1, 1, 1, 1, 2, nksrp ) 
     216         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 2, nksrp ) 
    217217            pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -0.5 * ( ekb(ji,jj,jk-1) + ekb(ji,jj,jk) ) ) 
    218218            pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -0.5 * ( ekg(ji,jj,jk-1) + ekg(ji,jj,jk) ) ) 
    … …  
    226226         we3(:,:) = zqsr(:,:) 
    227227         ! 
    228          DO_3D( 1, 1, 1, 1, 1, nksrp ) 
     228         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, nksrp ) 
    229229            ! integrate PAR over current t-level 
    230230            pe1(ji,jj,jk) = we1(ji,jj) / (ekb(ji,jj,jk) + rtrn) * (1. - EXP( -ekb(ji,jj,jk) )) 
Note: See TracChangeset for help on using the changeset viewer.