Ignore:
Timestamp:
2019-09-09T19:57:45+02:00 (14 months ago)
Author:
clem
Message:

add the final touch to the famous gaston's branch. More precisely, add the possibility to have melt ponds as input file when using bdy

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/ICE/icevar.F90

    r11507 r11518  
    159159            tm_s (:,:) = rt0 
    160160         END WHERE 
    161  
     161         ! 
     162         !                           ! mean melt pond depth 
     163         WHERE( at_ip(:,:) > epsi20 )   ;   hm_ip(:,:) = vt_ip(:,:) / at_ip(:,:) 
     164         ELSEWHERE                      ;   hm_ip(:,:) = 0._wp 
     165         END WHERE          
     166         ! 
    162167         DEALLOCATE( z1_at_i , z1_vt_i , z1_vt_s ) 
     168         ! 
    163169      ENDIF 
    164170      ! 
     
    659665      WHERE( pe_i (1:npti,:,:) < 0._wp .AND. pe_i (1:npti,:,:) > -epsi06 )   pe_i (1:npti,:,:) = 0._wp   !  e_i must be >= 0 
    660666      WHERE( pe_s (1:npti,:,:) < 0._wp .AND. pe_s (1:npti,:,:) > -epsi06 )   pe_s (1:npti,:,:) = 0._wp   !  e_s must be >= 0 
    661       IF ( ln_pnd_H12 ) THEN 
     667      IF( ln_pnd_H12 ) THEN 
    662668         WHERE( pa_ip(1:npti,:) < 0._wp .AND. pa_ip(1:npti,:) > -epsi10 )    pa_ip(1:npti,:)   = 0._wp   ! a_ip must be >= 0 
    663669         WHERE( pv_ip(1:npti,:) < 0._wp .AND. pv_ip(1:npti,:) > -epsi10 )    pv_ip(1:npti,:)   = 0._wp   ! v_ip must be >= 0 
     
    780786   !! ** Purpose :  converting N-cat ice to jpl ice categories 
    781787   !!------------------------------------------------------------------- 
    782    SUBROUTINE ice_var_itd_1c1c( phti, phts, pati ,       ph_i, ph_s, pa_i, & 
    783       &                         ptmi, ptms, ptmsu, psmi, pt_i, pt_s, pt_su, ps_i ) 
     788   SUBROUTINE ice_var_itd_1c1c( phti, phts, pati ,                       ph_i, ph_s, pa_i, & 
     789      &                         ptmi, ptms, ptmsu, psmi, patip, phtip,   pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip ) 
    784790      !!------------------------------------------------------------------- 
    785791      !! ** Purpose :  converting 1-cat ice to 1 ice category 
     
    787793      REAL(wp), DIMENSION(:), INTENT(in)    ::   phti, phts, pati    ! input  ice/snow variables 
    788794      REAL(wp), DIMENSION(:), INTENT(inout) ::   ph_i, ph_s, pa_i    ! output ice/snow variables 
    789       REAL(wp), DIMENSION(:), INTENT(in)    ::   ptmi, ptms, ptmsu, psmi    ! input  ice/snow temp & sal 
    790       REAL(wp), DIMENSION(:), INTENT(inout) ::   pt_i, pt_s, pt_su, ps_i    ! output ice/snow temp & sal 
     795      REAL(wp), DIMENSION(:), INTENT(in)    ::   ptmi, ptms, ptmsu, psmi, patip, phtip    ! input  ice/snow temp & sal & ponds 
     796      REAL(wp), DIMENSION(:), INTENT(inout) ::   pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip    ! output ice/snow temp & sal & ponds 
    791797      !!------------------------------------------------------------------- 
    792798      ! == thickness and concentration == ! 
     
    795801      pa_i(:) = pati(:) 
    796802      ! 
    797       ! == temperature and salinity == ! 
     803      ! == temperature and salinity and ponds == ! 
    798804      pt_i (:) = ptmi (:) 
    799805      pt_s (:) = ptms (:) 
    800806      pt_su(:) = ptmsu(:) 
    801807      ps_i (:) = psmi (:) 
     808      pa_ip(:) = patip(:) 
     809      ph_ip(:) = phtip(:) 
    802810       
    803811   END SUBROUTINE ice_var_itd_1c1c 
    804812 
    805    SUBROUTINE ice_var_itd_Nc1c( phti, phts, pati ,       ph_i, ph_s, pa_i, & 
    806       &                         ptmi, ptms, ptmsu, psmi, pt_i, pt_s, pt_su, ps_i ) 
     813   SUBROUTINE ice_var_itd_Nc1c( phti, phts, pati ,                       ph_i, ph_s, pa_i, & 
     814      &                         ptmi, ptms, ptmsu, psmi, patip, phtip,   pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip ) 
    807815      !!------------------------------------------------------------------- 
    808816      !! ** Purpose :  converting N-cat ice to 1 ice category 
     
    810818      REAL(wp), DIMENSION(:,:), INTENT(in)    ::   phti, phts, pati    ! input  ice/snow variables 
    811819      REAL(wp), DIMENSION(:)  , INTENT(inout) ::   ph_i, ph_s, pa_i    ! output ice/snow variables 
    812       REAL(wp), DIMENSION(:,:), INTENT(in)    ::   ptmi, ptms, ptmsu, psmi    ! input  ice/snow temp & sal 
    813       REAL(wp), DIMENSION(:)  , INTENT(inout) ::   pt_i, pt_s, pt_su, ps_i    ! output ice/snow temp & sal 
     820      REAL(wp), DIMENSION(:,:), INTENT(in)    ::   ptmi, ptms, ptmsu, psmi, patip, phtip    ! input  ice/snow temp & sal & ponds 
     821      REAL(wp), DIMENSION(:)  , INTENT(inout) ::   pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip    ! output ice/snow temp & sal & ponds 
    814822      ! 
    815823      REAL(wp), ALLOCATABLE, DIMENSION(:) ::   z1_ai, z1_vi, z1_vs 
     
    843851      pt_su(:) = SUM( ptmsu(:,:) * pati(:,:)            , dim=2 ) * z1_ai(:) 
    844852      ps_i (:) = SUM( psmi (:,:) * pati(:,:) * phti(:,:), dim=2 ) * z1_vi(:) 
     853 
     854      ! == ponds == ! 
     855      pa_ip(:) = SUM( patip(:,:), dim=2 ) 
     856      WHERE( pa_ip(:) /= 0._wp )   ;   ph_ip(:) = SUM( phtip(:,:) * patip(:,:), dim=2 ) / pa_ip(:) 
     857      ELSEWHERE                    ;   ph_ip(:) = 0._wp 
     858      END WHERE 
    845859      ! 
    846860      DEALLOCATE( z1_ai, z1_vi, z1_vs ) 
     
    848862   END SUBROUTINE ice_var_itd_Nc1c 
    849863    
    850    SUBROUTINE ice_var_itd_1cMc( phti, phts, pati ,       ph_i, ph_s, pa_i, & 
    851       &                         ptmi, ptms, ptmsu, psmi, pt_i, pt_s, pt_su, ps_i ) 
     864   SUBROUTINE ice_var_itd_1cMc( phti, phts, pati ,                       ph_i, ph_s, pa_i, & 
     865      &                         ptmi, ptms, ptmsu, psmi, patip, phtip,   pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip ) 
    852866      !!------------------------------------------------------------------- 
    853867      !! 
     
    880894      REAL(wp), DIMENSION(:),   INTENT(in)    ::   phti, phts, pati    ! input  ice/snow variables 
    881895      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   ph_i, ph_s, pa_i    ! output ice/snow variables 
    882       REAL(wp), DIMENSION(:)  , INTENT(in)    ::   ptmi, ptms, ptmsu, psmi    ! input  ice/snow temp & sal 
    883       REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pt_i, pt_s, pt_su, ps_i    ! output ice/snow temp & sal 
     896      REAL(wp), DIMENSION(:)  , INTENT(in)    ::   ptmi, ptms, ptmsu, psmi, patip, phtip    ! input  ice/snow temp & sal & ponds 
     897      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip    ! output ice/snow temp & sal & ponds 
    884898      ! 
    885899      INTEGER , DIMENSION(4) ::   itest 
     900      REAL(wp), ALLOCATABLE, DIMENSION(:) ::   zfra 
    886901      INTEGER  ::   ji, jk, jl 
    887902      INTEGER  ::   idim, i_fill, jl0   
     
    9971012      ! == temperature and salinity == ! 
    9981013      DO jl = 1, jpl 
    999          pt_i(:,jl) = ptmi (:) 
     1014         pt_i (:,jl) = ptmi (:) 
     1015         pt_s (:,jl) = ptms (:) 
     1016         pt_su(:,jl) = ptmsu(:) 
     1017         ps_i (:,jl) = psmi (:) 
     1018         ps_i (:,jl) = psmi (:)          
    10001019      END DO 
     1020      ! 
     1021      ! == ponds == ! 
     1022      ALLOCATE( zfra(idim) ) 
     1023      ! keep the same pond fraction atip/ati for each category 
     1024      WHERE( pati(:) /= 0._wp )   ;   zfra(:) = patip(:) / pati(:) 
     1025      ELSEWHERE                   ;   zfra(:) = 0._wp 
     1026      END WHERE 
    10011027      DO jl = 1, jpl 
    1002          pt_s (:,jl) = ptms (:) 
     1028         pa_ip(:,jl) = zfra(:) * pa_i(:,jl) 
    10031029      END DO 
     1030      ! keep the same v_ip/v_i ratio for each category 
     1031      WHERE( ( phti(:) * pati(:) ) /= 0._wp )   ;   zfra(:) = ( phtip(:) * patip(:) ) / ( phti(:) * pati(:) ) 
     1032      ELSEWHERE                                 ;   zfra(:) = 0._wp 
     1033      END WHERE 
    10041034      DO jl = 1, jpl 
    1005          pt_su(:,jl) = ptmsu(:) 
     1035         WHERE( pa_ip(:,jl) /= 0._wp )   ;   ph_ip(:,jl) = zfra(:) * ( ph_i(:,jl) * pa_i(:,jl) ) / pa_ip(:,jl) 
     1036         ELSEWHERE                       ;   ph_ip(:,jl) = 0._wp 
     1037         END WHERE 
    10061038      END DO 
    1007       DO jl = 1, jpl 
    1008          ps_i (:,jl) = psmi (:) 
    1009       END DO 
     1039      DEALLOCATE( zfra ) 
    10101040      ! 
    10111041   END SUBROUTINE ice_var_itd_1cMc 
    10121042 
    1013    SUBROUTINE ice_var_itd_NcMc( phti, phts, pati ,       ph_i, ph_s, pa_i, & 
    1014       &                         ptmi, ptms, ptmsu, psmi, pt_i, pt_s, pt_su, ps_i ) 
     1043   SUBROUTINE ice_var_itd_NcMc( phti, phts, pati ,                       ph_i, ph_s, pa_i, & 
     1044      &                         ptmi, ptms, ptmsu, psmi, patip, phtip,   pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip ) 
    10151045      !!------------------------------------------------------------------- 
    10161046      !! 
     
    10431073      REAL(wp), DIMENSION(:,:), INTENT(in)    ::   phti, phts, pati    ! input  ice/snow variables 
    10441074      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   ph_i, ph_s, pa_i    ! output ice/snow variables 
    1045       REAL(wp), DIMENSION(:,:), INTENT(in)    ::   ptmi, ptms, ptmsu, psmi    ! input  ice/snow temp & sal 
    1046       REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pt_i, pt_s, pt_su, ps_i    ! output ice/snow temp & sal 
     1075      REAL(wp), DIMENSION(:,:), INTENT(in)    ::   ptmi, ptms, ptmsu, psmi, patip, phtip    ! input  ice/snow temp & sal & ponds 
     1076      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip    ! output ice/snow temp & sal & ponds 
    10471077      ! 
    10481078      INTEGER , ALLOCATABLE, DIMENSION(:,:) ::   jlfil, jlfil2 
    10491079      INTEGER , ALLOCATABLE, DIMENSION(:)   ::   jlmax, jlmin 
    1050       REAL(wp), ALLOCATABLE, DIMENSION(:)   ::   z1_ai, z1_vi, z1_vs, ztmp 
     1080      REAL(wp), ALLOCATABLE, DIMENSION(:)   ::   z1_ai, z1_vi, z1_vs, ztmp, zfra 
    10511081      ! 
    10521082      REAL(wp), PARAMETER ::   ztrans = 0.25_wp 
     
    10661096         pa_i(:,:) = pati(:,:) 
    10671097         ! 
    1068          ! == temperature and salinity == ! 
     1098         ! == temperature and salinity and ponds == ! 
    10691099         pt_i (:,:) = ptmi (:,:) 
    10701100         pt_s (:,:) = ptms (:,:) 
    10711101         pt_su(:,:) = ptmsu(:,:) 
    10721102         ps_i (:,:) = psmi (:,:) 
     1103         pa_ip(:,:) = patip(:,:) 
     1104         ph_ip(:,:) = phtip(:,:) 
    10731105         !                              ! ---------------------- ! 
    10741106      ELSEIF( icat == 1 ) THEN          ! input cat = 1          ! 
    10751107         !                              ! ---------------------- ! 
    1076          CALL  ice_var_itd_1cMc( phti(:,1), phts(:,1), pati (:,1),            ph_i(:,:), ph_s(:,:), pa_i (:,:), & 
    1077             &                    ptmi(:,1), ptms(:,1), ptmsu(:,1), psmi(:,1), pt_i(:,:), pt_s(:,:), pt_su(:,:), ps_i(:,:) ) 
     1108         CALL  ice_var_itd_1cMc( phti(:,1), phts(:,1), pati (:,1), & 
     1109            &                    ph_i(:,:), ph_s(:,:), pa_i (:,:), & 
     1110            &                    ptmi(:,1), ptms(:,1), ptmsu(:,1), psmi(:,1), patip(:,1), phtip(:,1), & 
     1111            &                    pt_i(:,:), pt_s(:,:), pt_su(:,:), ps_i(:,:), pa_ip(:,:), ph_ip(:,:)  ) 
    10781112         !                              ! ---------------------- ! 
    10791113      ELSEIF( jpl == 1 ) THEN           ! output cat = 1         ! 
    10801114         !                              ! ---------------------- ! 
    1081          CALL  ice_var_itd_Nc1c( phti(:,:), phts(:,:), pati (:,:),            ph_i(:,1), ph_s(:,1), pa_i (:,1), & 
    1082             &                    ptmi(:,:), ptms(:,:), ptmsu(:,:), psmi(:,:), pt_i(:,1), pt_s(:,1), pt_su(:,1), ps_i(:,1) ) 
     1115         CALL  ice_var_itd_Nc1c( phti(:,:), phts(:,:), pati (:,:), & 
     1116            &                    ph_i(:,1), ph_s(:,1), pa_i (:,1), & 
     1117            &                    ptmi(:,:), ptms(:,:), ptmsu(:,:), psmi(:,:), patip(:,:), phtip(:,:), & 
     1118            &                    pt_i(:,1), pt_s(:,1), pt_su(:,1), ps_i(:,1), pa_ip(:,1), ph_ip(:,1)  ) 
    10831119         !                              ! ----------------------- ! 
    10841120      ELSE                              ! input cat /= output cat ! 
     
    12021238         DEALLOCATE( z1_ai, z1_vi, z1_vs, ztmp ) 
    12031239         ! 
     1240         ! == ponds == ! 
     1241         ALLOCATE( zfra(idim) ) 
     1242         ! keep the same pond fraction atip/ati for each category 
     1243         WHERE( SUM( pati(:,:), dim=2 ) /= 0._wp )   ;   zfra(:) = SUM( patip(:,:), dim=2 ) / SUM( pati(:,:), dim=2 ) 
     1244         ELSEWHERE                                   ;   zfra(:) = 0._wp 
     1245         END WHERE 
     1246         DO jl = 1, jpl 
     1247            pa_ip(:,jl) = zfra(:) * pa_i(:,jl) 
     1248         END DO 
     1249         ! keep the same v_ip/v_i ratio for each category 
     1250         WHERE( SUM( phti(:,:) * pati(:,:), dim=2 ) /= 0._wp ) 
     1251            zfra(:) = SUM( phtip(:,:) * patip(:,:), dim=2 ) / SUM( phti(:,:) * pati(:,:), dim=2 ) 
     1252         ELSEWHERE 
     1253            zfra(:) = 0._wp 
     1254         END WHERE 
     1255         DO jl = 1, jpl 
     1256            WHERE( pa_ip(:,jl) /= 0._wp )   ;   ph_ip(:,jl) = zfra(:) * ( ph_i(:,jl) * pa_i(:,jl) ) / pa_ip(:,jl) 
     1257            ELSEWHERE                       ;   ph_ip(:,jl) = 0._wp 
     1258            END WHERE 
     1259         END DO 
     1260         DEALLOCATE( zfra ) 
     1261         ! 
    12041262      ENDIF 
    12051263      ! 
Note: See TracChangeset for help on using the changeset viewer.