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 13799 for NEMO/branches/2020/dev_r13787_SI3-10_EAP/tests/ICE_RHEO/MY_SRC – NEMO

Ignore:
Timestamp:
2020-11-16T12:04:05+01:00 (4 years ago)
Author:
acc
Message:

Branch dev_r13787_SI3-10_EAP. Tidying up. Removing some commented debug statements and applying do loop macros consistently

Location:
NEMO/branches/2020/dev_r13787_SI3-10_EAP/tests/ICE_RHEO/MY_SRC
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2020/dev_r13787_SI3-10_EAP/tests/ICE_RHEO/MY_SRC/icedyn_rhg_eap.F90

    r13797 r13799  
    1313   !!            3.7  !  2017     (C. Rousset)  add aEVP (Kimmritz 2016-2017) 
    1414   !!            4.0  !  2018     (many people) SI3 [aka Sea Ice cube] 
    15    !!                 !  2019     (S. Rynders)  change into eap rheology from 
     15   !!                 !  2019     (S. Rynders, Y. Aksenov, C. Rousset)  change into eap rheology from 
    1616   !!                                           CICE code (Tsamados, Heorton)  
    1717   !!---------------------------------------------------------------------- 
     
    450450 
    451451            ! structure tensor update 
    452 !!$               IF (mod(jter,10) == 0) THEN 
    453452               CALL calc_ffrac(zstressptmp, zstressmtmp, zstress12tmp(ji,jj), paniso_11(ji,jj), paniso_12(ji,jj), zmresult11,  zmresult12) 
    454453 
    455 !!$                  paniso_11(ji,jj) = (paniso_11(ji,jj)*z1_dtevp_A  + zp5kth + zmresult11) * z1dtevpkth ! implicit 
    456 !!$                  paniso_12(ji,jj) = (paniso_12(ji,jj)*z1_dtevp_A  + zmresult12) * z1dtevpkth ! implicit 
    457454               paniso_11(ji,jj) = (paniso_11(ji,jj)  + 0.5*2.e-5*zdtevp + zmresult11*zdtevp) / (1. + 2.e-5*zdtevp) ! implicit 
    458455               paniso_12(ji,jj) = (paniso_12(ji,jj)                     + zmresult12*zdtevp) / (1. + 2.e-5*zdtevp) ! implicit 
    459 !!$               ENDIF 
    460456 
    461457            IF (jter == nn_nevp) THEN 
     
    510506             
    511507            ! stress at F points (zkt/=0 if landfast) 
    512             !zs12(ji,jj)= ( zs12(ji,jj) * zalph2 + zp_delf * ( zds(ji,jj) * z1_ecc2 * (1._wp + zkt) ) * 0.5_wp ) * z1_alph2 
    513 !!$               zs12(ji,jj) = ( zs12(ji,jj) + zstress12tmpF * zalph1  ) * z1_alph1 
    514508            zs12(ji,jj) = ( zs12(ji,jj) * zalph1 + zstress12tmpF ) * z1_alph1 
    515             !zs12(ji,jj) = ( stress12tmpF * zs12(ji,jj) + zalph1  ) * z1_alph1 
    516509 
    517510         END_2D 
     
    599592            ! 
    600593#if defined key_agrif 
    601 !!            CALL agrif_interp_ice( 'V', jter, nn_nevp ) 
     594!!          CALL agrif_interp_ice( 'V', jter, nn_nevp ) 
    602595            CALL agrif_interp_ice( 'V' ) 
    603596#endif 
     
    656649            ! 
    657650#if defined key_agrif 
    658 !!            CALL agrif_interp_ice( 'U', jter, nn_nevp ) 
     651!!          CALL agrif_interp_ice( 'U', jter, nn_nevp ) 
    659652            CALL agrif_interp_ice( 'U' ) 
    660653#endif 
     
    714707            ! 
    715708#if defined key_agrif 
    716 !!            CALL agrif_interp_ice( 'U', jter, nn_nevp ) 
     709!!          CALL agrif_interp_ice( 'U', jter, nn_nevp ) 
    717710            CALL agrif_interp_ice( 'U' ) 
    718711#endif 
     
    770763            ! 
    771764#if defined key_agrif 
    772 !!            CALL agrif_interp_ice( 'V', jter, nn_nevp ) 
     765!!          CALL agrif_interp_ice( 'V', jter, nn_nevp ) 
    773766            CALL agrif_interp_ice( 'V' ) 
    774767#endif 
     
    14581451               CALL iom_get( numrir, jpdom_auto, 'stress2_i' , stress2_i , cd_type = 'T' ) 
    14591452               CALL iom_get( numrir, jpdom_auto, 'stress12_i', stress12_i, cd_type = 'F' ) 
    1460                CALL iom_get( numrir, jpdom_auto, 'aniso_11'  , aniso_11  , cd_type = 'T'   ) 
    1461                CALL iom_get( numrir, jpdom_auto, 'aniso_12'  , aniso_12  , cd_type = 'T'   ) 
     1453               CALL iom_get( numrir, jpdom_auto, 'aniso_11'  , aniso_11  , cd_type = 'T' ) 
     1454               CALL iom_get( numrir, jpdom_auto, 'aniso_12'  , aniso_12  , cd_type = 'T' ) 
    14621455            ELSE                                     ! start rheology from rest 
    14631456               IF(lwp) WRITE(numout,*) 
  • NEMO/branches/2020/dev_r13787_SI3-10_EAP/tests/ICE_RHEO/MY_SRC/usrdef_hgr.F90

    r13797 r13799  
    2828   !! * Substitutions 
    2929#  include "do_loop_substitute.h90" 
    30 #  include "domzgr_substitute.h90" 
    3130   !!---------------------------------------------------------------------- 
    3231   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
  • NEMO/branches/2020/dev_r13787_SI3-10_EAP/tests/ICE_RHEO/MY_SRC/usrdef_sbc.F90

    r13797 r13799  
    3434 
    3535   !! * Substitutions 
     36#  include "do_loop_substitute.h90" 
    3637   !!---------------------------------------------------------------------- 
    3738   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    119120      IF( kt==nit000 .AND. lwp)   WRITE(numout,*)' usrdef_sbc_ice : ICE_RHEO case: analytical stress forcing' 
    120121 
    121       DO jj = 2, jpjm1 
    122          DO ji = 2, jpim1    
    123             ! wind spins up over 6 hours, factor 1000 to balance the units 
    124             windu(ji,jj) = Umax/sqrt(d*1000)*(d-2*mig(ji)*res)/((d-2*mig(ji)*res)**2+(d-2*mjg(jj)*res)**2*Rwind**2)**(1/4)*min(kt*30./21600,1.) 
    125             windv(ji,jj) = Umax/sqrt(d*1000)*(d-2*mjg(jj)*res)/((d-2*mig(ji)*res)**2+(d-2*mjg(jj)*res)**2*Rwind**2)**(1/4)*Rwind*min(kt*30./21600,1.) 
    126          END DO 
    127       END DO 
     122      DO_2D( 0, 0, 0, 0 ) 
     123         ! wind spins up over 6 hours, factor 1000 to balance the units 
     124         windu(ji,jj) = Umax/sqrt(d*1000)*(d-2*mig(ji)*res)/((d-2*mig(ji)*res)**2+(d-2*mjg(jj)*res)**2*Rwind**2)**(1/4)*min(kt*30./21600,1.) 
     125         windv(ji,jj) = Umax/sqrt(d*1000)*(d-2*mjg(jj)*res)/((d-2*mig(ji)*res)**2+(d-2*mjg(jj)*res)**2*Rwind**2)**(1/4)*Rwind*min(kt*30./21600,1.) 
     126      END_2D 
    128127      CALL lbc_lnk_multi( 'usrdef_sbc', windu, 'U', -1., windv, 'V', -1. ) 
    129128 
     
    134133      ! ------------------------------------------------------------ ! 
    135134      ! C-grid ice dynamics :   U & V-points (same as ocean) 
    136       DO jj = 2, jpjm1 
    137          DO ji = 2, jpim1    
    138             zwndi_t = (  windu(ji,jj) - r_vfac * 0.5 * ( u_ice(ji-1,jj  ) + u_ice(ji,jj) )  ) 
    139             zwndj_t = (  windv(ji,jj) - r_vfac * 0.5 * ( v_ice(ji,jj-1) + v_ice(ji,jj) )  ) 
    140             wndm_ice(ji,jj) = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1) 
    141          END DO 
    142       END DO 
     135      DO_2D( 0, 0, 0, 0 ) 
     136         zwndi_t = (  windu(ji,jj) - r_vfac * 0.5 * ( u_ice(ji-1,jj  ) + u_ice(ji,jj) )  ) 
     137         zwndj_t = (  windv(ji,jj) - r_vfac * 0.5 * ( v_ice(ji,jj-1) + v_ice(ji,jj) )  ) 
     138         wndm_ice(ji,jj) = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1) 
     139      END_2D 
    143140      CALL lbc_lnk( 'usrdef_sbc', wndm_ice, 'T',  1. ) 
    144141 
     
    152149      ! ------------------------------------------------------------ ! 
    153150      ! C-grid ice dynamics :   U & V-points (same as ocean) 
    154       DO jj = 2, jpjm1 
    155          DO ji = 2, jpim1    
    156             utau_ice(ji,jj) = 0.5 * zrhoa * Cd_atm * ( wndm_ice(ji+1,jj  ) + wndm_ice(ji,jj) )            & 
    157                &          * ( 0.5 * (windu(ji+1,jj) + windu(ji,jj) ) - r_vfac * u_ice(ji,jj) ) 
    158             vtau_ice(ji,jj) = 0.5 * zrhoa * Cd_atm * ( wndm_ice(ji,jj+1  ) + wndm_ice(ji,jj) )            & 
    159                &          * ( 0.5 * (windv(ji,jj+1) + windv(ji,jj) ) - r_vfac * v_ice(ji,jj) ) 
    160          END DO 
    161       END DO 
     151      DO_2D( 0, 0, 0, 0 ) 
     152         utau_ice(ji,jj) = 0.5 * zrhoa * Cd_atm * ( wndm_ice(ji+1,jj  ) + wndm_ice(ji,jj) )            & 
     153            &          * ( 0.5 * (windu(ji+1,jj) + windu(ji,jj) ) - r_vfac * u_ice(ji,jj) ) 
     154         vtau_ice(ji,jj) = 0.5 * zrhoa * Cd_atm * ( wndm_ice(ji,jj+1  ) + wndm_ice(ji,jj) )            & 
     155            &          * ( 0.5 * (windv(ji,jj+1) + windv(ji,jj) ) - r_vfac * v_ice(ji,jj) ) 
     156      END_2D 
    162157      CALL lbc_lnk_multi( 'usrdef_sbc', utau_ice, 'U', -1., vtau_ice, 'V', -1. ) 
    163158      ! 
Note: See TracChangeset for help on using the changeset viewer.