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 719 for trunk/NEMO/LIM_SRC/limdyn.F90 – NEMO

Ignore:
Timestamp:
2007-10-16T16:59:56+02:00 (17 years ago)
Author:
ctlod
Message:

get back to the nemo_v2_3 version for trunk

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMO/LIM_SRC/limdyn.F90

    • Property svn:keywords changed from Id to Author Date Id Revision
    r717 r719  
    44   !!   Sea-Ice dynamics :   
    55   !!====================================================================== 
    6    !! History :   1.0  !  01-04  (LIM)  Original code 
    7    !!             2.0  !  02-08  (C. Ethe, G. Madec)  F90, mpp 
    8    !!             2.0  !  03-08  (C. Ethe) add lim_dyn_init 
    9    !!             2.0  !  06-07  (G. Madec)  Surface module 
    10    !!--------------------------------------------------------------------- 
    116#if defined key_ice_lim 
    127   !!---------------------------------------------------------------------- 
     
    1611   !!    lim_dyn_init : initialization and namelist read 
    1712   !!---------------------------------------------------------------------- 
    18    USE dom_oce        ! ocean space and time domain 
    19    USE sbc_oce        ! 
    20    USE phycst         ! 
    21    USE ice            ! 
    22    USE ice_oce        ! 
    23    USE dom_ice        ! 
    24    USE iceini         ! 
    25    USE limistate      ! 
    26    USE limrhg         ! ice rheology 
    27  
    28    USE lbclnk         ! 
    29    USE lib_mpp        ! 
    30    USE in_out_manager ! I/O manager 
    31    USE prtctl         ! Print control 
     13   !! * Modules used 
     14   USE phycst 
     15   USE in_out_manager  ! I/O manager 
     16   USE dom_ice 
     17   USE dom_oce         ! ocean space and time domain 
     18   USE ice 
     19   USE ice_oce 
     20   USE iceini 
     21   USE limistate 
     22   USE limrhg          ! ice rheology 
     23   USE lbclnk 
     24   USE lib_mpp 
     25   USE prtctl          ! Print control 
    3226 
    3327   IMPLICIT NONE 
    3428   PRIVATE 
    3529 
    36    PUBLIC   lim_dyn   ! routine called by ice_step 
    37  
     30   !! * Accessibility 
     31   PUBLIC lim_dyn  ! routine called by ice_step 
     32 
     33   !! * Module variables 
    3834   REAL(wp)  ::  rone    = 1.e0   ! constant value 
    3935 
    40 #  include "vectopt_loop_substitute.h90" 
    41    !!---------------------------------------------------------------------- 
    42    !!   LIM 2.0,  UCL-LOCEAN-IPSL (2006)  
    43    !! $Id$ 
    44    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     36   !!---------------------------------------------------------------------- 
     37   !!   LIM 2.0,  UCL-LOCEAN-IPSL (2005)  
     38   !! $Header$  
     39   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    4540   !!---------------------------------------------------------------------- 
    4641 
     
    5954      !!              - computation of the stress at the ocean surface          
    6055      !!              - treatment of the case if no ice dynamic 
     56      !! History : 
     57      !!   1.0  !  01-04  (LIM)  Original code 
     58      !!   2.0  !  02-08  (C. Ethe, G. Madec)  F90, mpp 
    6159      !!--------------------------------------------------------------------- 
    6260      INTEGER, INTENT(in) ::   kt     ! number of iteration 
    63       !! 
    64       INTEGER  ::   ji, jj             ! dummy loop indices 
    65       INTEGER  ::   i_j1, i_jpj        ! Starting/ending j-indices for rheology 
    66       REAL(wp) ::   zcoef              ! temporary scalar 
    67       REAL(wp), DIMENSION(jpj)     ::   zind           ! i-averaged indicator of sea-ice 
    68       REAL(wp), DIMENSION(jpj)     ::   zmsk           ! i-averaged of tmask 
    69       REAL(wp), DIMENSION(jpi,jpj) ::   zu_io, zv_io   ! ice-ocean velocity 
    70 !!$      INTEGER ::   ji, jj             ! dummy loop indices 
    71 !!$      INTEGER ::   i_j1, i_jpj        ! Starting/ending j-indices for rheology 
    72 !!$      REAL(wp) ::   & 
    73 !!$         ztairx, ztairy,           &  ! tempory scalars 
    74 !!$         zsang , zrhomod,             & 
    75 !!$         ztglx , ztgly ,           & 
    76 !!$         zt11, zt12, zt21, zt22 ,  & 
    77 !!$         zustm, zsfrld, zsfrldm4,  & 
    78 !!$         zu_ice, zv_ice, ztair2 
    79 !!$      REAL(wp),DIMENSION(jpi,jpj) ::   zmod 
    80 !!$      REAL(wp),DIMENSION(jpj) ::   & 
    81 !!$         zind,                     &  ! i-averaged indicator of sea-ice 
    82 !!$         zmsk                         ! i-averaged of tmask 
     61 
     62      INTEGER ::   ji, jj             ! dummy loop indices 
     63      INTEGER ::   i_j1, i_jpj        ! Starting/ending j-indices for rheology 
     64      REAL(wp) ::   & 
     65         ztairx, ztairy,           &  ! tempory scalars 
     66         zsang , zmod,             & 
     67         ztglx , ztgly ,           & 
     68         zt11, zt12, zt21, zt22 ,  & 
     69         zustm, zsfrld, zsfrldm4,  & 
     70         zu_ice, zv_ice, ztair2 
     71      REAL(wp),DIMENSION(jpj) ::   & 
     72         zind,                     &  ! i-averaged indicator of sea-ice 
     73         zmsk                         ! i-averaged of tmask 
    8374      !!--------------------------------------------------------------------- 
    8475 
    85       IF( kt == nit000 )   CALL lim_dyn_init   ! Initialization (first time-step only) 
     76      IF( kt == nit000  )   CALL lim_dyn_init   ! Initialization (first time-step only) 
    8677       
    87       IF( ln_limdyn ) THEN 
     78      IF ( ln_limdyn ) THEN 
    8879 
    8980         ! Mean ice and snow thicknesses.           
     
    9182         hicm(:,:)  = ( 1.0 - frld(:,:) ) * hicif(:,:) 
    9283 
     84         u_oce(:,:)  = u_io(:,:) * tmu(:,:) 
     85         v_oce(:,:)  = v_io(:,:) * tmu(:,:) 
     86        
    9387         !                                         ! Rheology (ice dynamics) 
    9488         !                                         ! ======== 
     
    10094            i_j1 = 1    
    10195            i_jpj = jpj 
    102             IF(ln_ctl)   CALL prt_ctl_info( 'lim_dyn  :    i_j1 = ', ivar1=i_j1, clinfo2=' ij_jpj = ', ivar2=i_jpj ) 
     96            IF(ln_ctl)    THEN 
     97               CALL prt_ctl_info('lim_dyn  :    i_j1 = ', ivar1=i_j1, clinfo2=' ij_jpj = ', ivar2=i_jpj) 
     98            ENDIF 
    10399            CALL lim_rhg( i_j1, i_jpj ) 
    104100 
     
    108104               zind(jj) = SUM( frld (:,jj  ) )   ! = FLOAT(jpj) if ocean everywhere on a j-line 
    109105               zmsk(jj) = SUM( tmask(:,jj,1) )   ! = 0          if land  everywhere on a j-line 
     106   !!i         write(numout,*) narea, 'limdyn' , jj, zind(jj), zmsk(jj) 
    110107            END DO 
    111108 
     
    158155         ENDIF 
    159156 
    160          IF(ln_ctl)   CALL prt_ctl(tab2d_1=ui_ice , clinfo1=' lim_dyn  : ui_ice :', tab2d_2=vi_ice , clinfo2=' vi_ice :') 
     157         IF(ln_ctl)   THEN  
     158            CALL prt_ctl(tab2d_1=u_oce , clinfo1=' lim_dyn  : u_oce :', tab2d_2=v_oce , clinfo2=' v_oce :') 
     159            CALL prt_ctl(tab2d_1=u_ice , clinfo1=' lim_dyn  : u_ice :', tab2d_2=v_ice , clinfo2=' v_ice :') 
     160         ENDIF 
    161161          
    162 !!$         !                                         ! Ice-Ocean stress 
    163 !!$         !                                         ! ================         
    164 !!$         DO jj = 1, jpj 
    165 !!$            DO ji = 1, jpi 
    166 !!$!!              zsang  = SIGN(1.e0, gphif(ji-1,jj-1) ) * sangvg    ! do the full loop and avoid lbc_lnk 
    167 !!$               zsang  = SIGN(1.e0, gphif(ji,jj) ) * sangvg 
    168 !!$               zu_ice   = u_ice(ji,jj) - u_io(ji,jj) 
    169 !!$               zv_ice   = v_ice(ji,jj) - v_io(ji,jj) 
    170 !!$               zrhomod  = zu_ice * zu_ice + zv_ice * zv_ice  
    171 !!$               zmod (ji,jj) = zrhomod  
    172 !!$               zrhomod  = rhoco * SQRT( zrhomod )  
    173 !!$               ftaux(ji,jj) = zrhomod * ( cangvg * zu_ice - zsang * zv_ice )  
    174 !!$               ftauy(ji,jj) = zrhomod * ( cangvg * zv_ice + zsang * zu_ice )  
    175 !!$            END DO 
    176 !!$         END DO 
    177  
    178          ! computation of friction velocity 
    179          ! -------------------------------- 
    180          ! ice-ocean velocity at U & V-points (ui_ice vi_ice at I-point ; ssu_m, ssv_m at U- & V-points) 
    181           
    182          DO jj = 1, jpjm1 
    183             DO ji = 1, fs_jpim1   ! vector opt. 
    184                zu_io(ji,jj) = 0.5 * ( ui_ice(ji+1,jj+1) + ui_ice(ji+1,jj  ) ) - ssu_m(ji,jj) 
    185                zv_io(ji,jj) = 0.5 * ( vi_ice(ji+1,jj+1) + vi_ice(ji  ,jj+1) ) - ssv_m(ji,jj) 
     162         !                                         ! Ice-Ocean stress 
     163         !                                         ! ================ 
     164         DO jj = 2, jpjm1 
     165            zsang  = SIGN(1.e0, gphif(1,jj-1) ) * sangvg 
     166            DO ji = 2, jpim1 
     167               ! computation of wind stress over ocean in X and Y direction 
     168#if defined key_coupled && defined key_lim_cp1 
     169               ztairx =  frld(ji-1,jj  ) * gtaux(ji-1,jj  ) + frld(ji,jj  ) * gtaux(ji,jj  )      & 
     170                  &    + frld(ji-1,jj-1) * gtaux(ji-1,jj-1) + frld(ji,jj-1) * gtaux(ji,jj-1) 
     171 
     172               ztairy =  frld(ji-1,jj  ) * gtauy(ji-1,jj  ) + frld(ji,jj  ) * gtauy(ji,jj  )      & 
     173                  &    + frld(ji-1,jj-1) * gtauy(ji-1,jj-1) + frld(ji,jj-1) * gtauy(ji,jj-1) 
     174#else 
     175               zsfrld  = frld(ji,jj) + frld(ji-1,jj) + frld(ji-1,jj-1) + frld(ji,jj-1) 
     176               ztairx  = zsfrld * gtaux(ji,jj) 
     177               ztairy  = zsfrld * gtauy(ji,jj) 
     178#endif 
     179               zsfrldm4 = 4 - frld(ji,jj) - frld(ji-1,jj) - frld(ji-1,jj-1) - frld(ji,jj-1) 
     180               zu_ice   = u_ice(ji,jj) - u_oce(ji,jj) 
     181               zv_ice   = v_ice(ji,jj) - v_oce(ji,jj) 
     182               zmod     = SQRT( zu_ice * zu_ice + zv_ice * zv_ice )  
     183               ztglx   = zsfrldm4 * rhoco * zmod * ( cangvg * zu_ice - zsang * zv_ice )  
     184               ztgly   = zsfrldm4 * rhoco * zmod * ( cangvg * zv_ice + zsang * zu_ice )  
     185 
     186               tio_u(ji,jj) = - ( ztairx + 1.0 * ztglx ) / ( 4 * rau0 ) 
     187               tio_v(ji,jj) = - ( ztairy + 1.0 * ztgly ) / ( 4 * rau0 ) 
    186188            END DO 
    187189         END DO 
    188          ! frictional velocity at T-point 
     190          
     191         ! computation of friction velocity 
    189192         DO jj = 2, jpjm1 
    190             DO ji = fs_2, fs_jpim1   ! vector opt. 
    191                ust2s(ji,jj) = 0.5 * cw                                                          & 
    192                   &         * (  zu_io(ji,jj) * zu_io(ji,jj) + zu_io(ji-1,jj) * zu_io(ji-1,jj)   & 
    193                   &            + zv_io(ji,jj) * zv_io(ji,jj) + zv_io(ji,jj-1) * zv_io(ji,jj-1)   ) * tms(ji,jj) 
     193            DO ji = 2, jpim1 
     194 
     195               zu_ice   = u_ice(ji-1,jj-1) - u_oce(ji-1,jj-1) 
     196               zv_ice   = v_ice(ji-1,jj-1) - v_oce(ji-1,jj-1) 
     197               zt11  = rhoco * ( zu_ice * zu_ice + zv_ice * zv_ice ) 
     198 
     199               zu_ice   = u_ice(ji-1,jj) - u_oce(ji-1,jj) 
     200               zv_ice   = v_ice(ji-1,jj) - v_oce(ji-1,jj) 
     201               zt12  = rhoco * ( zu_ice * zu_ice + zv_ice * zv_ice )  
     202 
     203               zu_ice   = u_ice(ji,jj-1) - u_oce(ji,jj-1) 
     204               zv_ice   = v_ice(ji,jj-1) - v_oce(ji,jj-1) 
     205               zt21  = rhoco * ( zu_ice * zu_ice + zv_ice * zv_ice )  
     206 
     207               zu_ice   = u_ice(ji,jj) - u_oce(ji,jj) 
     208               zv_ice   = v_ice(ji,jj) - v_oce(ji,jj) 
     209               zt22  = rhoco * ( zu_ice * zu_ice + zv_ice * zv_ice )  
     210 
     211               ztair2 = gtaux(ji,jj) * gtaux(ji,jj) + gtauy(ji,jj) * gtauy(ji,jj) 
     212 
     213               zustm =  ( 1 - frld(ji,jj) ) * 0.25 * ( zt11 + zt12 + zt21 + zt22 )        & 
     214                  &  +        frld(ji,jj)   * SQRT( ztair2 ) 
     215 
     216               ust2s(ji,jj) = ( zustm / rau0 ) * ( rone + sdvt(ji,jj) ) * tms(ji,jj) 
    194217            END DO 
    195218         END DO 
    196 !!$         DO jj = 2, jpjm1 
    197 !!$            DO ji = fs_2, fs_jpim1     ! vector opt. 
    198 !!$               ust2s(ji,jj) = 0.25 * cw * ( zmod(ji,jj+1) + zmod(ji+1,jj+1) +    & 
    199 !!$                  &                         zmod(ji,jj  ) + zmod(ji+1,jj  ) ) * tms(ji,jj) 
    200 !!$            END DO 
    201 !!$         END DO 
    202          ! 
    203       ELSE      ! no ice dynamics : transmit directly the atmospheric stress to the ocean 
    204          ! 
    205          zcoef = SQRT( 0.5 ) / rau0 
    206          DO jj = 2, jpjm1 
    207             DO ji = fs_2, fs_jpim1   ! vector opt. 
    208                ust2s(ji,jj) = zcoef * tms(ji,jj) * SQRT(  utau(ji,jj) * utau(ji,jj) + utau(ji-1,jj) * utau(ji-1,jj)   & 
    209                   &                                     + vtau(ji,jj) * vtau(ji,jj) + vtau(ji,jj-1) * vtau(ji,jj-1) ) 
     219 
     220       ELSE      ! no ice dynamics : transmit directly the atmospheric stress to the ocean 
     221                     
     222          DO jj = 2, jpjm1 
     223             DO ji = 2, jpim1 
     224#if defined key_coupled && defined key_lim_cp1 
     225                tio_u(ji,jj) = - (  gtaux(ji  ,jj  ) + gtaux(ji-1,jj  )       & 
     226                   &              + gtaux(ji-1,jj-1) + gtaux(ji  ,jj-1) ) / ( 4 * rau0 ) 
     227 
     228                tio_v(ji,jj) = - (  gtauy(ji  ,jj )  + gtauy(ji-1,jj  )       & 
     229                   &              + gtauy(ji-1,jj-1) + gtauy(ji  ,jj-1) ) / ( 4 * rau0 ) 
     230#else 
     231                tio_u(ji,jj) = - gtaux(ji,jj) / rau0 
     232                tio_v(ji,jj) = - gtauy(ji,jj) / rau0  
     233#endif 
     234                ztair2       = gtaux(ji,jj) * gtaux(ji,jj) + gtauy(ji,jj) * gtauy(ji,jj) 
     235                zustm        = SQRT( ztair2  ) 
     236 
     237                ust2s(ji,jj) = ( zustm / rau0 ) * ( rone + sdvt(ji,jj) ) * tms(ji,jj) 
    210238            END DO 
    211239         END DO 
    212          ! 
     240 
    213241      ENDIF 
    214242 
    215243      CALL lbc_lnk( ust2s, 'T',  1. )   ! T-point 
    216  
    217       IF(ln_ctl)   CALL prt_ctl(tab2d_1=ust2s , clinfo1=' lim_dyn  : ust2s :') 
     244      CALL lbc_lnk( tio_u, 'I', -1. )   ! I-point (i.e. ice U-V point) 
     245      CALL lbc_lnk( tio_v, 'I', -1. )   ! I-point (i.e. ice U-V point) 
     246 
     247      IF(ln_ctl) THEN  
     248            CALL prt_ctl(tab2d_1=tio_u , clinfo1=' lim_dyn  : tio_u :', tab2d_2=tio_v , clinfo2=' tio_v :') 
     249            CALL prt_ctl(tab2d_1=ust2s , clinfo1=' lim_dyn  : ust2s :') 
     250      ENDIF 
    218251 
    219252   END SUBROUTINE lim_dyn 
     
    224257      !!                  ***  ROUTINE lim_dyn_init  *** 
    225258      !! 
    226       !! ** Purpose :   Physical constants and parameters linked to the ice 
    227       !!              dynamics 
    228       !! 
    229       !! ** Method  :   Read the namicedyn namelist and check the ice-dynamic 
    230       !!              parameter values 
     259      !! ** Purpose : Physical constants and parameters linked to the ice 
     260      !!      dynamics 
     261      !! 
     262      !! ** Method  :  Read the namicedyn namelist and check the ice-dynamic 
     263      !!       parameter values called at the first timestep (nit000) 
    231264      !! 
    232265      !! ** input   :   Namelist namicedyn 
     266      !! 
     267      !! history : 
     268      !!  8.5  ! 03-08 (C. Ethe) original code 
    233269      !!------------------------------------------------------------------- 
    234270      NAMELIST/namicedyn/ epsd, alpha,     & 
     
    237273      !!------------------------------------------------------------------- 
    238274 
    239       REWIND ( numnam_ice )                       ! Read Namelist namicedyn 
     275      ! Define the initial parameters 
     276      ! ------------------------- 
     277 
     278      ! Read Namelist namicedyn 
     279      REWIND ( numnam_ice ) 
    240280      READ   ( numnam_ice  , namicedyn ) 
    241  
    242       IF(lwp) THEN                                ! Control print 
     281      IF(lwp) THEN 
    243282         WRITE(numout,*) 
    244283         WRITE(numout,*) 'lim_dyn_init : ice parameters for ice dynamics ' 
     
    252291         WRITE(numout,*) '       maximum value for the residual of relaxation     resl   = ', resl 
    253292         WRITE(numout,*) '       drag coefficient for oceanic stress              cw     = ', cw 
    254          WRITE(numout,*) '       turning angle for oceanic stress                 angvg  = ', angvg, ' degrees' 
     293         WRITE(numout,*) '       turning angle for oceanic stress                 angvg  = ', angvg 
    255294         WRITE(numout,*) '       first bulk-rheology parameter                    pstar  = ', pstar 
    256295         WRITE(numout,*) '       second bulk-rhelogy parameter                    c_rhg  = ', c_rhg 
     
    261300      ENDIF 
    262301 
     302      !  Initialization 
    263303      usecc2 = 1.0 / ( ecc * ecc ) 
    264304      rhoco  = rau0 * cw 
    265       angvg  = angvg * rad      ! convert angvg from degree to radian 
     305      angvg  = angvg * rad 
    266306      sangvg = SIN( angvg ) 
    267307      cangvg = COS( angvg ) 
    268308      pstarh = pstar / 2.0 
    269       ! 
    270       ahiu(:,:) = ahi0 * umask(:,:,1)            ! Ice eddy Diffusivity coefficients. 
     309      sdvt(:,:) = 0.e0 
     310 
     311      !  Diffusion coefficients. 
     312      ahiu(:,:) = ahi0 * umask(:,:,1) 
    271313      ahiv(:,:) = ahi0 * vmask(:,:,1) 
    272       ! 
     314 
    273315   END SUBROUTINE lim_dyn_init 
    274316 
Note: See TracChangeset for help on using the changeset viewer.