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 5581 for branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/NEMO/LIM_SRC_2/limthd_2.F90 – NEMO

Ignore:
Timestamp:
2015-07-10T13:28:53+02:00 (9 years ago)
Author:
timgraham
Message:

Merged head of trunk into branch

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/NEMO/LIM_SRC_2/limthd_2.F90

    r4696 r5581  
    3333   USE limtab_2 
    3434   USE prtctl           ! Print control 
    35    USE cpl_oasis3, ONLY :   lk_cpl 
    36    USE diaar5    , ONLY :   lk_diaar5 
    3735   USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    3836    
     
    116114      CALL wrk_alloc( jpi, jpj, jpk, zmsk ) 
    117115 
    118       IF( kt == nit000 )   CALL lim_thd_init_2  ! Initialization (first time-step only) 
     116      IF( kt == nit000 )   CALL lim_thd_init_2   ! Initialization (first time-step only) 
    119117    
    120118      !-------------------------------------------! 
     
    139137      rdq_ice(:,:) = 0.e0   ! heat content associated with rdm_ice 
    140138      zmsk (:,:,:) = 0.e0 
    141       IF( ltrcdm2dc_ice  ) fstric_daymean (:,:) = 0.e0   ! part of solar radiation absorbing inside the ice 
    142139 
    143140      ! set to zero snow thickness smaller than epsi04 
     
    219216                         
    220217            !  partial computation of the lead energy budget (qldif) 
    221 #if defined key_coupled  
    222             qldif(ji,jj)   = tms(ji,jj) * rdt_ice                                                  & 
    223                &    * (   ( qsr_tot(ji,jj) - qsr_ice(ji,jj,1) * zfricp ) * ( 1.0 - thcm(ji,jj) )   & 
    224                &        + ( qns_tot(ji,jj) - qns_ice(ji,jj,1) * zfricp )                           & 
    225                &        + frld(ji,jj) * ( fdtcn(ji,jj) + ( 1.0 - zindb ) * fsbbq(ji,jj) )   ) 
    226 #else 
    227             qldif(ji,jj)   = tms(ji,jj) * rdt_ice * frld(ji,jj)                    & 
    228                &                        * (  qsr(ji,jj) * ( 1.0 - thcm(ji,jj) )    & 
    229                &                           + qns(ji,jj)  +  fdtcn(ji,jj)           & 
    230                &                           + ( 1.0 - zindb ) * fsbbq(ji,jj)      ) 
    231 #endif 
     218            IF( ln_cpl ) THEN  
     219               qldif(ji,jj)   = tms(ji,jj) * rdt_ice                                                  & 
     220                  &    * (   ( qsr_tot(ji,jj) - qsr_ice(ji,jj,1) * zfricp ) * ( 1.0 - thcm(ji,jj) )   & 
     221                  &        + ( qns_tot(ji,jj) - qns_ice(ji,jj,1) * zfricp )                           & 
     222                  &        + frld(ji,jj) * ( fdtcn(ji,jj) + ( 1.0 - zindb ) * fsbbq(ji,jj) )   ) 
     223            ELSE 
     224               qldif(ji,jj)   = tms(ji,jj) * rdt_ice * frld(ji,jj)                    & 
     225                  &                        * (  qsr(ji,jj) * ( 1.0 - thcm(ji,jj) )    & 
     226                  &                           + qns(ji,jj)  +  fdtcn(ji,jj)           & 
     227                  &                           + ( 1.0 - zindb ) * fsbbq(ji,jj)      ) 
     228            ENDIF 
    232229            !  parlat : percentage of energy used for lateral ablation (0.0)  
    233230            zfntlat        = 1.0 - MAX( rzero , SIGN( rone ,  - qldif(ji,jj) ) ) 
     
    287284         CALL tab_2d_1d_2( nbpb, tbif_1d    (1:nbpb , 3 ), tbif(:,:,3)    , jpi, jpj, npb(1:nbpb) ) 
    288285         CALL tab_2d_1d_2( nbpb, qsr_ice_1d (1:nbpb)     , qsr_ice(:,:,1) , jpi, jpj, npb(1:nbpb) ) 
    289          IF( ltrcdm2dc_ice ) & 
    290          & CALL tab_2d_1d_2( nbpb, qsr_ice_mean_1d (1:nbpb), qsr_ice_mean(:,:,1), jpi, jpj, npb(1:nbpb) ) 
    291286         CALL tab_2d_1d_2( nbpb, fr1_i0_1d  (1:nbpb)     , fr1_i0         , jpi, jpj, npb(1:nbpb) ) 
    292287         CALL tab_2d_1d_2( nbpb, fr2_i0_1d  (1:nbpb)     , fr2_i0         , jpi, jpj, npb(1:nbpb) ) 
    293288         CALL tab_2d_1d_2( nbpb,  qns_ice_1d(1:nbpb)     ,  qns_ice(:,:,1), jpi, jpj, npb(1:nbpb) ) 
    294289         CALL tab_2d_1d_2( nbpb, dqns_ice_1d(1:nbpb)     , dqns_ice(:,:,1), jpi, jpj, npb(1:nbpb) ) 
    295          IF( .NOT. lk_cpl ) THEN  
     290         IF( .NOT. ln_cpl ) THEN  
    296291            CALL tab_2d_1d_2( nbpb, qla_ice_1d (1:nbpb)     ,  qla_ice(:,:,1), jpi, jpj, npb(1:nbpb) ) 
    297292            CALL tab_2d_1d_2( nbpb, dqla_ice_1d(1:nbpb)     , dqla_ice(:,:,1), jpi, jpj, npb(1:nbpb) ) 
     
    338333         CALL tab_1d_2d_2( nbpb, qsr_ice(:,:,1), npb, qsr_ice_1d(1:nbpb)  , jpi, jpj ) 
    339334         CALL tab_1d_2d_2( nbpb, qns_ice(:,:,1), npb, qns_ice_1d(1:nbpb)  , jpi, jpj ) 
    340          IF( ltrcdm2dc_ice )THEN 
    341             CALL tab_1d_2d_2( nbpb, fstric_daymean     , npb, fstbif_daymean_1d (1:nbpb)  , jpi, jpj ) 
    342             CALL tab_1d_2d_2( nbpb, qsr_ice_mean(:,:,1), npb,    qsr_ice_mean_1d(1:nbpb)  , jpi, jpj ) 
    343          ENDIF 
    344          IF( .NOT. lk_cpl )   CALL tab_1d_2d_2( nbpb, qla_ice(:,:,1), npb, qla_ice_1d(1:nbpb)             , jpi, jpj ) 
     335         IF( .NOT. ln_cpl )   CALL tab_1d_2d_2( nbpb, qla_ice(:,:,1), npb, qla_ice_1d(1:nbpb), jpi, jpj ) 
    345336         ! 
    346337      ENDIF 
     
    440431      !-------------------------------------------------------------------------------- 
    441432      ztmp(:,:) = 1. - pfrld(:,:)                                ! fraction of ice after the dynamic, before the thermodynamic 
    442       CALL iom_put( 'ist_cea', (sist(:,:) - rt0) * ztmp(:,:) )   ! Ice surface temperature                [Celius] 
    443       CALL iom_put( 'qsr_ai_cea', qsr_ice(:,:,1) * ztmp(:,:) )   ! Solar flux over the ice                [W/m2] 
    444       CALL iom_put( 'qns_ai_cea', qns_ice(:,:,1) * ztmp(:,:) )   ! Non-solar flux over the ice            [W/m2] 
    445       IF( .NOT. lk_cpl )   CALL iom_put( 'qla_ai_cea', qla_ice(:,:,1) * ztmp(:,:) )     ! Latent flux over the ice  [W/m2] 
     433      IF( iom_use('ist_cea'    ) )   CALL iom_put( 'ist_cea', (sist(:,:) - rt0) * ztmp(:,:) )   ! Ice surface temperature   [Celius] 
     434      IF( iom_use('qsr_ai_cea' ) )   CALL iom_put( 'qsr_ai_cea', qsr_ice(:,:,1) * ztmp(:,:) )   ! Solar flux over the ice     [W/m2] 
     435      IF( iom_use('qns_ai_cea' ) )   CALL iom_put( 'qns_ai_cea', qns_ice(:,:,1) * ztmp(:,:) )   ! Non-solar flux over the ice [W/m2] 
     436      IF( iom_use('qla_ai_cea' ) .AND. .NOT. ln_cpl ) & 
     437         &                           CALL iom_put( 'qla_ai_cea', qla_ice(:,:,1) * ztmp(:,:) )   ! Latent flux over the ice [W/m2] 
    446438      ! 
    447       CALL iom_put( 'snowthic_cea', hsnif  (:,:) * fr_i(:,:) )   ! Snow thickness             [m] 
    448       CALL iom_put( 'icethic_cea' , hicif  (:,:) * fr_i(:,:) )   ! Ice thickness              [m] 
     439      IF( iom_use('snowthic_cea'))   CALL iom_put( 'snowthic_cea', hsnif  (:,:) * fr_i(:,:) )   ! Snow thickness           [m] 
     440      IF( iom_use('icethic_cea' ))   CALL iom_put( 'icethic_cea' , hicif  (:,:) * fr_i(:,:) )   ! Ice thickness            [m] 
    449441      zztmp = 1.0 / rdt_ice 
    450       CALL iom_put( 'iceprod_cea' , hicifp (:,:) * zztmp     )   ! Ice produced               [m/s] 
    451       IF( lk_diaar5 ) THEN 
    452          CALL iom_put( 'snowmel_cea' , rdm_snw(:,:) * zztmp     )   ! Snow melt                  [kg/m2/s] 
    453          zztmp = rhoic / rdt_ice 
    454          CALL iom_put( 'sntoice_cea' , zdvonif(:,:) * zztmp     )   ! Snow to Ice transformation [kg/m2/s] 
    455          CALL iom_put( 'ticemel_cea' , zdvosif(:,:) * zztmp     )   ! Melt at Sea Ice top        [kg/m2/s] 
    456          CALL iom_put( 'bicemel_cea' , zdvomif(:,:) * zztmp     )   ! Melt at Sea Ice bottom     [kg/m2/s] 
     442      IF( iom_use('iceprod_cea') )   CALL iom_put( 'iceprod_cea' , hicifp (:,:) * zztmp     )   ! Ice produced             [m/s] 
     443      IF( iom_use('iiceconc'   ) )   CALL iom_put( 'iiceconc'    , fr_i(:,:)                )   ! Ice concentration        [-] 
     444      IF( iom_use('snowmel_cea') )   CALL iom_put( 'snowmel_cea' , rdm_snw(:,:) * zztmp     )   ! Snow melt                [kg/m2/s] 
     445      zztmp = rhoic / rdt_ice 
     446      IF( iom_use('sntoice_cea') )   CALL iom_put( 'sntoice_cea' , zdvonif(:,:) * zztmp     ) ! Snow to Ice transformation [kg/m2/s] 
     447      IF( iom_use('ticemel_cea') )   CALL iom_put( 'ticemel_cea' , zdvosif(:,:) * zztmp     )   ! Melt at Sea Ice top      [kg/m2/s] 
     448      IF( iom_use('bicemel_cea') )   CALL iom_put( 'bicemel_cea' , zdvomif(:,:) * zztmp     )   ! Melt at Sea Ice bottom   [kg/m2/s] 
     449      IF( iom_use('licepro_cea') ) THEN 
    457450         zlicegr(:,:) = MAX( 0.e0, rdm_ice(:,:)-zlicegr(:,:) ) 
    458          CALL iom_put( 'licepro_cea' , zlicegr(:,:) * zztmp     )   ! Lateral sea ice growth     [kg/m2/s] 
     451                                     CALL iom_put( 'licepro_cea' , zlicegr(:,:) * zztmp     )   ! Lateral sea ice growth   [kg/m2/s] 
    459452      ENDIF 
    460453      ! 
    461454      ! Compute the Eastward & Northward sea-ice transport 
    462       zztmp = 0.25 * rhoic 
    463       DO jj = 1, jpjm1  
    464          DO ji = 1, jpim1   ! NO vector opt. 
    465             ! Ice velocities, volume & transport at U & V-points 
    466             zuice_m = u_ice(ji+1,jj+1) + u_ice(ji+1,jj ) 
    467             zvice_m = v_ice(ji+1,jj+1) + v_ice(ji ,jj+1) 
    468             zhice_u = hicif(ji,jj)*e2t(ji,jj)*fr_i(ji,jj) + hicif(ji+1,jj  )*e2t(ji+1,jj  )*fr_i(ji+1,jj  ) 
    469             zhice_v = hicif(ji,jj)*e1t(ji,jj)*fr_i(ji,jj) + hicif(ji  ,jj+1)*e1t(ji  ,jj+1)*fr_i(ji  ,jj+1) 
    470             zu_imasstr(ji,jj) = zztmp * zhice_u * zuice_m  
    471             zv_imasstr(ji,jj) = zztmp * zhice_v * zvice_m  
    472          END DO 
    473       END DO 
    474       CALL lbc_lnk( zu_imasstr, 'U', -1. )   ;   CALL lbc_lnk( zv_imasstr, 'V', -1. ) 
    475       CALL iom_put( 'u_imasstr',  zu_imasstr(:,:) )   ! Ice transport along i-axis at U-point [kg/s]  
    476       CALL iom_put( 'v_imasstr',  zv_imasstr(:,:) )   ! Ice transport along j-axis at V-point [kg/s]  
     455      IF( iom_use('u_imasstr') ) THEN 
     456         zztmp = 0.25 * rhoic 
     457         DO jj = 1, jpjm1  
     458            DO ji = 1, jpim1   ! NO vector opt. 
     459               ! Ice velocities, volume & transport at U-points 
     460               zuice_m = u_ice(ji+1,jj+1) + u_ice(ji+1,jj ) 
     461               zhice_u = hicif(ji,jj)*e2t(ji,jj)*fr_i(ji,jj) + hicif(ji+1,jj  )*e2t(ji+1,jj  )*fr_i(ji+1,jj  ) 
     462               zu_imasstr(ji,jj) = zztmp * zhice_u * zuice_m  
     463            END DO 
     464         END DO 
     465         CALL lbc_lnk( zu_imasstr, 'U', -1. ) 
     466         CALL iom_put( 'u_imasstr',  zu_imasstr(:,:) )   ! Ice transport along i-axis at U-point [kg/s]  
     467      ENDIF 
     468      IF( iom_use('v_imasstr') ) THEN 
     469         zztmp = 0.25 * rhoic 
     470         DO jj = 1, jpjm1  
     471            DO ji = 1, jpim1   ! NO vector opt. 
     472               ! Ice velocities, volume & transport at V-points 
     473               zvice_m = v_ice(ji+1,jj+1) + v_ice(ji ,jj+1) 
     474               zhice_v = hicif(ji,jj)*e1t(ji,jj)*fr_i(ji,jj) + hicif(ji  ,jj+1)*e1t(ji  ,jj+1)*fr_i(ji  ,jj+1) 
     475               zv_imasstr(ji,jj) = zztmp * zhice_v * zvice_m  
     476            END DO 
     477         END DO 
     478         CALL lbc_lnk( zv_imasstr, 'V', -1. ) 
     479         CALL iom_put( 'v_imasstr',  zv_imasstr(:,:) )   ! Ice transport along j-axis at V-point [kg/s] 
     480      ENDIF 
    477481 
    478482      !! Fram Strait sea-ice transport (sea-ice + snow)  (in ORCA2 = 5 points) 
    479       IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN    ! ORCA R2 configuration 
     483      IF( iom_use('fram_trans') .and. cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN    ! ORCA R2 configuration 
    480484         DO jj = mj0(137), mj1(137) ! B grid 
    481485            IF( mj0(jj-1) >= nldj ) THEN 
     
    491495      ENDIF 
    492496 
     497      IF( iom_use('ice_pres') .OR. iom_use('ist_ipa') .OR. iom_use('uice_ipa') .OR. iom_use('vice_ipa') ) THEN 
    493498!! ce     ztmp(:,:) = 1. - AINT( frld(:,:), wp )                        ! return 1 as soon as there is ice 
    494499!! ce     A big warning because the model crashes on IDRIS/IBM SP6 with xlf 13.1.0.3, see ticket #761 
    495 !! ce     We Unroll the loop and everything works fine  
    496       DO jj = 1, jpj 
    497          DO ji = 1, jpi 
    498             ztmp(ji,jj) = 1. - AINT( frld(ji,jj), wp )                ! return 1 as soon as there is ice 
    499          END DO 
    500       END DO 
    501       ! 
    502       CALL iom_put( 'ice_pres'  , ztmp                            )   ! Ice presence                          [-] 
    503       CALL iom_put( 'ist_ipa'   , ( sist(:,:) - rt0 ) * ztmp(:,:) )   ! Ice surface temperature               [Celius] 
    504       CALL iom_put( 'uice_ipa'  ,  u_ice(:,:)         * ztmp(:,:) )   ! Ice velocity along i-axis at I-point  [m/s]  
    505       CALL iom_put( 'vice_ipa'  ,  v_ice(:,:)         * ztmp(:,:) )   ! Ice velocity along j-axis at I-point  [m/s] 
     500!! ce     We Unroll the loop and everything works fine       
     501         DO jj = 1, jpj 
     502            DO ji = 1, jpi 
     503               ztmp(ji,jj) = 1. - AINT( frld(ji,jj), wp )                ! return 1 as soon as there is ice 
     504            END DO 
     505         END DO 
     506         ! 
     507         IF( iom_use('ice_pres') ) CALL iom_put( 'ice_pres', ztmp                            )   ! Ice presence                 [-] 
     508         IF( iom_use('ist_ipa' ) ) CALL iom_put( 'ist_ipa' , ( sist(:,:) - rt0 ) * ztmp(:,:) )   ! Ice surface temperature [Celius] 
     509         IF( iom_use('uice_ipa') ) CALL iom_put( 'uice_ipa', u_ice(:,:) * ztmp(:,:) ) ! Ice velocity along i-axis at I-point  [m/s]  
     510         IF( iom_use('vice_ipa') ) CALL iom_put( 'vice_ipa', v_ice(:,:) * ztmp(:,:) ) ! Ice velocity along j-axis at I-point  [m/s] 
     511      ENDIF 
    506512 
    507513      IF(ln_ctl) THEN 
     
    551557      IF(lwm) WRITE ( numoni, namicethd ) 
    552558 
    553       IF( lk_cpl .AND. parsub /= 0.0 )   CALL ctl_stop( 'In coupled mode, use parsub = 0. or send dqla' ) 
     559      IF( ln_cpl .AND. parsub /= 0.0 )   CALL ctl_stop( 'In coupled mode, use parsub = 0. or send dqla' ) 
    554560      ! 
    555561      IF(lwp) THEN                          ! control print 
Note: See TracChangeset for help on using the changeset viewer.