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 3294 for trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90 – NEMO

Ignore:
Timestamp:
2012-01-28T17:44:18+01:00 (12 years ago)
Author:
rblod
Message:

Merge of 3.4beta into the trunk

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90

    r2777 r3294  
    2222   USE in_out_manager   ! I/O manager 
    2323   USE lib_mpp          ! MPP library 
     24   USE wrk_nemo         ! work arrays 
    2425 
    2526   IMPLICIT NONE 
    … …  
    9091      !!           (04-2007) Energy conservation tested by M. Vancoppenolle 
    9192      !!------------------------------------------------------------------ 
    92       INTEGER , INTENT (in) ::  & 
    93          kideb ,  &  ! Start point on which the  the computation is applied 
    94          kiut  ,  &  ! End point on which the  the computation is applied 
    95          jl          ! Category number 
     93      INTEGER , INTENT (in) ::   kideb   ! Start point on which the  the computation is applied 
     94      INTEGER , INTENT (in) ::   kiut    ! End point on which the  the computation is applied 
     95      INTEGER , INTENT (in) ::   jl      ! Category number 
    9696 
    9797      !! * Local variables 
    98       INTEGER ::   ji,       &   ! spatial loop index 
    99          ii, ij, &   ! temporary dummy loop index 
    100          numeq,    &   ! current reference number of equation 
    101          layer,    &   ! vertical dummy loop index  
    102          nconv,    &   ! number of iterations in iterative procedure 
    103          minnumeqmin, maxnumeqmax 
    104  
    105       INTEGER , DIMENSION(kiut) :: & 
    106          numeqmin, &   ! reference number of top equation 
    107          numeqmax, &   ! reference number of bottom equation 
    108          isnow         ! switch for presence (1) or absence (0) of snow 
     98      INTEGER ::   ji          ! spatial loop index 
     99      INTEGER ::   ii, ij      ! temporary dummy loop index 
     100      INTEGER ::   numeq       ! current reference number of equation 
     101      INTEGER ::   layer       ! vertical dummy loop index  
     102      INTEGER ::   nconv       ! number of iterations in iterative procedure 
     103      INTEGER ::   minnumeqmin, maxnumeqmax 
     104 
     105      INTEGER , POINTER, DIMENSION(:) ::   numeqmin   ! reference number of top equation 
     106      INTEGER , POINTER, DIMENSION(:) ::   numeqmax   ! reference number of bottom equation 
     107      INTEGER , POINTER, DIMENSION(:) ::   isnow      ! switch for presence (1) or absence (0) of snow 
    109108 
    110109      !! * New local variables        
    111       REAL(wp) , DIMENSION(kiut,0:nlay_i) ::    & 
    112          ztcond_i,    & !Ice thermal conductivity 
    113          zradtr_i,    & !Radiation transmitted through the ice 
    114          zradab_i,    & !Radiation absorbed in the ice 
    115          zkappa_i       !Kappa factor in the ice 
    116  
    117       REAL(wp) , DIMENSION(kiut,0:nlay_s) ::    & 
    118          zradtr_s,    & !Radiation transmited through the snow 
    119          zradab_s,    & !Radiation absorbed in the snow 
    120          zkappa_s       !Kappa factor in the snow 
    121  
    122       REAL(wp) , DIMENSION(kiut,0:nlay_i) :: & 
    123          ztiold,      & !Old temperature in the ice 
    124          zeta_i,      & !Eta factor in the ice  
    125          ztitemp,     & !Temporary temperature in the ice to check the convergence 
    126          zspeche_i,   & !Ice specific heat 
    127          z_i            !Vertical cotes of the layers in the ice 
    128  
    129       REAL(wp) , DIMENSION(kiut,0:nlay_s) :: & 
    130          zeta_s,      & !Eta factor in the snow 
    131          ztstemp,     & !Temporary temperature in the snow to check the convergence 
    132          ztsold,      & !Temporary temperature in the snow 
    133          z_s            !Vertical cotes of the layers in the snow 
    134  
    135       REAL(wp) , DIMENSION(kiut,jkmax+2) ::    & 
    136          zindterm,    & ! Independent term 
    137          zindtbis,    & ! temporary independent term 
    138          zdiagbis 
    139  
    140       REAL(wp) , DIMENSION(kiut,jkmax+2,3) ::   ztrid   ! tridiagonal system terms 
    141  
    142       REAL(wp), DIMENSION(kiut) ::  & 
    143          ztfs     ,   & ! ice melting point 
    144          ztsuold  ,   & ! old surface temperature (before the iterative procedure ) 
    145          ztsuoldit,   & ! surface temperature at previous iteration 
    146          zh_i     ,   & !ice layer thickness 
    147          zh_s     ,   & !snow layer thickness 
    148          zfsw     ,   & !solar radiation absorbed at the surface 
    149          zf       ,   & ! surface flux function 
    150          dzf            ! derivative of the surface flux function 
    151  
    152       REAL(wp)  ::           &  ! constant values 
    153          zeps      =  1.e-10_wp,   & ! 
    154          zg1s      =  2._wp,       & !: for the tridiagonal system 
    155          zg1       =  2._wp,       & 
    156          zgamma    =  18009._wp,   & !: for specific heat 
    157          zbeta     =  0.117_wp,    & !: for thermal conductivity (could be 0.13) 
    158          zraext_s  =  1.e+8_wp,    & !: extinction coefficient of radiation in the snow 
    159          zkimin    =  0.10_wp ,    & !: minimum ice thermal conductivity 
    160          zht_smin  =  1.e-4_wp       !: minimum snow depth 
     110      REAL(wp), POINTER, DIMENSION(:,:) ::   ztcond_i   !Ice thermal conductivity 
     111      REAL(wp), POINTER, DIMENSION(:,:) ::   zradtr_i   !Radiation transmitted through the ice 
     112      REAL(wp), POINTER, DIMENSION(:,:) ::   zradab_i   !Radiation absorbed in the ice 
     113      REAL(wp), POINTER, DIMENSION(:,:) ::   zkappa_i   !Kappa factor in the ice 
     114 
     115      REAL(wp), POINTER, DIMENSION(:,:) ::   zradtr_s   !Radiation transmited through the snow 
     116      REAL(wp), POINTER, DIMENSION(:,:) ::   zradab_s   !Radiation absorbed in the snow 
     117      REAL(wp), POINTER, DIMENSION(:,:) ::   zkappa_s   !Kappa factor in the snow 
     118 
     119      REAL(wp), POINTER, DIMENSION(:,:) ::   ztiold      !Old temperature in the ice 
     120      REAL(wp), POINTER, DIMENSION(:,:) ::   zeta_i      !Eta factor in the ice  
     121      REAL(wp), POINTER, DIMENSION(:,:) ::   ztitemp     !Temporary temperature in the ice to check the convergence 
     122      REAL(wp), POINTER, DIMENSION(:,:) ::   zspeche_i   !Ice specific heat 
     123      REAL(wp), POINTER, DIMENSION(:,:) ::   z_i         !Vertical cotes of the layers in the ice 
     124 
     125      REAL(wp), POINTER, DIMENSION(:,:) ::   zeta_s      !Eta factor in the snow 
     126      REAL(wp), POINTER, DIMENSION(:,:) ::   ztstemp     !Temporary temperature in the snow to check the convergence 
     127      REAL(wp), POINTER, DIMENSION(:,:) ::   ztsold      !Temporary temperature in the snow 
     128      REAL(wp), POINTER, DIMENSION(:,:) ::   z_s         !Vertical cotes of the layers in the snow 
     129 
     130      REAL(wp), POINTER, DIMENSION(:,:)   ::   zindterm    ! Independent term 
     131      REAL(wp), POINTER, DIMENSION(:,:)   ::   zindtbis    ! temporary independent term 
     132      REAL(wp), POINTER, DIMENSION(:,:)   ::   zdiagbis 
     133      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrid       ! tridiagonal system terms 
     134 
     135      REAL(wp), POINTER, DIMENSION(:) ::   ztfs        ! ice melting point 
     136      REAL(wp), POINTER, DIMENSION(:) ::   ztsuold     ! old surface temperature (before the iterative procedure ) 
     137      REAL(wp), POINTER, DIMENSION(:) ::   ztsuoldit   ! surface temperature at previous iteration 
     138      REAL(wp), POINTER, DIMENSION(:) ::   zh_i        ! ice layer thickness 
     139      REAL(wp), POINTER, DIMENSION(:) ::   zh_s        ! snow layer thickness 
     140      REAL(wp), POINTER, DIMENSION(:) ::   zfsw        ! solar radiation absorbed at the surface 
     141      REAL(wp), POINTER, DIMENSION(:) ::   zf          ! surface flux function 
     142      REAL(wp), POINTER, DIMENSION(:) ::   dzf         ! derivative of the surface flux function 
     143 
     144      REAL(wp) ::   zeps      =  1.e-10_wp    ! 
     145      REAL(wp) ::   zg1s      =  2._wp        ! for the tridiagonal system 
     146      REAL(wp) ::   zg1       =  2._wp        ! 
     147      REAL(wp) ::   zgamma    =  18009._wp    ! for specific heat 
     148      REAL(wp) ::   zbeta     =  0.117_wp     ! for thermal conductivity (could be 0.13) 
     149      REAL(wp) ::   zraext_s  =  1.e+8_wp     ! extinction coefficient of radiation in the snow 
     150      REAL(wp) ::   zkimin    =  0.10_wp      ! minimum ice thermal conductivity 
     151      REAL(wp) ::   zht_smin  =  1.e-4_wp     ! minimum snow depth 
    161152 
    162153      REAL(wp) ::   ztmelt_i    ! ice melting temperature 
    163154      REAL(wp) ::   zerritmax   ! current maximal error on temperature  
    164       REAL(wp), DIMENSION(kiut) ::   zerrit       ! current error on temperature  
    165       REAL(wp), DIMENSION(kiut) ::   zdifcase     ! case of the equation resolution (1->4) 
    166       REAL(wp), DIMENSION(kiut) ::   zftrice      ! solar radiation transmitted through the ice 
    167       REAL(wp), DIMENSION(kiut) ::   zihic, zhsu 
     155      REAL(wp), POINTER, DIMENSION(:) ::   zerrit       ! current error on temperature  
     156      REAL(wp), POINTER, DIMENSION(:) ::   zdifcase     ! case of the equation resolution (1->4) 
     157      REAL(wp), POINTER, DIMENSION(:) ::   zftrice      ! solar radiation transmitted through the ice 
     158      REAL(wp), POINTER, DIMENSION(:) ::   zihic, zhsu 
    168159      !!------------------------------------------------------------------ 
    169160      ! 
     161      CALL wrk_alloc( kiut, numeqmin, numeqmax, isnow )   ! integer 
     162      CALL wrk_alloc( kiut,nlay_i+1, ztcond_i, zradtr_i, zradab_i, zkappa_i, ztiold, zeta_i, ztitemp, zspeche_i, z_i, kjstart=0 ) 
     163      CALL wrk_alloc( kiut,nlay_s+1, zradtr_s, zradab_s, zkappa_s, zeta_s, ztstemp, ztsold, z_s, kjstart=0 ) 
     164      CALL wrk_alloc( kiut,jkmax+2, zindterm, zindtbis, zdiagbis ) 
     165      CALL wrk_alloc( kiut,jkmax+2,3, ztrid ) 
     166      CALL wrk_alloc( kiut, ztfs, ztsuold, ztsuoldit, zh_i, zh_s, zfsw, zf, dzf ) 
     167      CALL wrk_alloc( kiut, zerrit, zdifcase, zftrice, zihic, zhsu ) 
     168 
    170169      !------------------------------------------------------------------------------! 
    171170      ! 1) Initialization                                                            ! 
    … …  
    773772      ENDIF 
    774773      ! 
     774      CALL wrk_dealloc( kiut, numeqmin, numeqmax, isnow )   ! integer 
     775      CALL wrk_dealloc( kiut,nlay_i+1, ztcond_i, zradtr_i, zradab_i, zkappa_i, ztiold, zeta_i, ztitemp, zspeche_i, z_i, kjstart=0 ) 
     776      CALL wrk_dealloc( kiut,nlay_s+1, zradtr_s, zradab_s, zkappa_s, zeta_s, ztstemp, ztsold, z_s, kjstart=0 ) 
     777      CALL wrk_dealloc( kiut,jkmax+2, zindterm, zindtbis, zdiagbis ) 
     778      CALL wrk_dealloc( kiut,jkmax+2,3, ztrid ) 
     779      CALL wrk_dealloc( kiut, ztfs, ztsuold, ztsuoldit, zh_i, zh_s, zfsw, zf, dzf ) 
     780      CALL wrk_dealloc( kiut, zerrit, zdifcase, zftrice, zihic, zhsu ) 
     781 
    775782   END SUBROUTINE lim_thd_dif 
    776783 
Note: See TracChangeset for help on using the changeset viewer.