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 6020 for branches/UKMO/icebergs_restart_single_file/NEMOGCM/NEMO/NST_SRC/agrif_lim2_interp.F90 – NEMO

Ignore:
Timestamp:
2015-12-08T12:39:53+01:00 (8 years ago)
Author:
timgraham
Message:

Merged with head of trunk

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/icebergs_restart_single_file/NEMOGCM/NEMO/NST_SRC/agrif_lim2_interp.F90

    r6019 r6020  
    99   !!            3.4   !  09-2012  (R. Benshila, C. Herbaut) update and EVP 
    1010   !!---------------------------------------------------------------------- 
    11 #if defined key_agrif && defined key_lim2 
     11#if defined key_agrif && defined key_lim2  
    1212   !!---------------------------------------------------------------------- 
    1313   !!   'key_lim2'  :                                 LIM 2.0 sea-ice model 
     
    4141   PUBLIC interp_adv_ice 
    4242 
     43   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, PRIVATE :: uice_agr, vice_agr 
     44   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, PRIVATE :: tabice_agr  
     45 
     46 
    4347   !!---------------------------------------------------------------------- 
    4448   !! NEMO/NST 3.4 , NEMO Consortium (2012) 
     
    6569      u_ice_nst(:,:) = 0. 
    6670      v_ice_nst(:,:) = 0. 
    67       CALL Agrif_Bc_variable( u_ice_nst, u_ice_id ,procname=interp_u_ice, calledweight=1. ) 
    68       CALL Agrif_Bc_variable( v_ice_nst, v_ice_id ,procname=interp_v_ice, calledweight=1. ) 
     71      CALL Agrif_Bc_variable( u_ice_id ,procname=interp_u_ice, calledweight=1. ) 
     72      CALL Agrif_Bc_variable( v_ice_id ,procname=interp_v_ice, calledweight=1. ) 
    6973      Agrif_SpecialValue=0. 
    7074      Agrif_UseSpecialValue = .FALSE. 
     
    138142      !!  we are in inside a new parent ice time step 
    139143      !!----------------------------------------------------------------------- 
    140       REAL(wp), DIMENSION(jpi,jpj) :: zuice, zvice 
    141144      INTEGER :: ji,jj 
    142145      REAL(wp) :: zrhox, zrhoy 
     
    155158         Agrif_SpecialValue=-9999. 
    156159         Agrif_UseSpecialValue = .TRUE. 
    157          zuice = 0. 
    158          zvice = 0. 
    159          CALL Agrif_Bc_variable(zuice,u_ice_id,procname=interp_u_ice, calledweight=1.) 
    160          CALL Agrif_Bc_variable(zvice,v_ice_id,procname=interp_v_ice, calledweight=1.) 
     160         IF( .NOT. ALLOCATED(uice_agr) )THEN 
     161            ALLOCATE(uice_agr(jpi,jpj), vice_agr(jpi,jpj)) 
     162         ENDIF 
     163         uice_agr = 0. 
     164         vice_agr = 0. 
     165         CALL Agrif_Bc_variable(u_ice_id,procname=interp_u_ice, calledweight=1.) 
     166         CALL Agrif_Bc_variable(v_ice_id,procname=interp_v_ice, calledweight=1.) 
    161167         Agrif_SpecialValue=0. 
    162168         Agrif_UseSpecialValue = .FALSE. 
    163169         !   
    164170         zrhox = agrif_rhox() ;    zrhoy = agrif_rhoy()       
    165          zuice(:,:) =  zuice(:,:)/(zrhoy*e2u(:,:))*umask(:,:,1) 
    166          zvice(:,:) =  zvice(:,:)/(zrhox*e1v(:,:))*vmask(:,:,1) 
     171         uice_agr(:,:) =  uice_agr(:,:)/(zrhoy*e2u(:,:))*umask(:,:,1) 
     172         vice_agr(:,:) =  vice_agr(:,:)/(zrhox*e1v(:,:))*vmask(:,:,1) 
    167173         ! fill  boundaries 
    168174         DO jj = 1, jpj 
    169175            DO ji = 1, 2 
    170                u_ice_oe(ji,  jj,2) = zuice(ji       ,jj)  
    171                u_ice_oe(ji+2,jj,2) = zuice(nlci+ji-3,jj) 
     176               u_ice_oe(ji,  jj,2) = uice_agr(ji       ,jj)  
     177               u_ice_oe(ji+2,jj,2) = uice_agr(nlci+ji-3,jj) 
    172178            END DO 
    173179         END DO 
    174180         DO jj = 1, jpj 
    175             v_ice_oe(2,jj,2) = zvice(2     ,jj)  
    176             v_ice_oe(4,jj,2) = zvice(nlci-1,jj) 
     181            v_ice_oe(2,jj,2) = vice_agr(2     ,jj)  
     182            v_ice_oe(4,jj,2) = vice_agr(nlci-1,jj) 
    177183         END DO 
    178184         DO ji = 1, jpi 
    179             u_ice_sn(ji,2,2) = zuice(ji,2     )  
    180             u_ice_sn(ji,4,2) = zuice(ji,nlcj-1) 
     185            u_ice_sn(ji,2,2) = uice_agr(ji,2     )  
     186            u_ice_sn(ji,4,2) = uice_agr(ji,nlcj-1) 
    181187         END DO 
    182188         DO jj = 1, 2 
    183189            DO ji = 1, jpi 
    184                v_ice_sn(ji,jj  ,2) = zvice(ji,jj       )  
    185                v_ice_sn(ji,jj+2,2) = zvice(ji,nlcj+jj-3) 
     190               v_ice_sn(ji,jj  ,2) = vice_agr(ji,jj       )  
     191               v_ice_sn(ji,jj+2,2) = vice_agr(ji,nlcj+jj-3) 
    186192            END DO 
    187193         END DO 
     
    334340      !!  we are in inside a new parent ice time step 
    335341     !!----------------------------------------------------------------------- 
    336       REAL(wp), DIMENSION(jpi,jpj,7) :: ztab  
    337342      INTEGER :: ji,jj,jn 
    338343      !!----------------------------------------------------------------------- 
     
    345350         adv_ice_sn(:,:,:,1) =  adv_ice_sn(:,:,:,2) 
    346351         ! interpolation of boundaries 
    347          ztab(:,:,:) = 0. 
     352         IF(.NOT.ALLOCATED(tabice_agr))THEN 
     353            ALLOCATE(tabice_agr(jpi,jpj,7))    
     354         ENDIF 
     355         tabice_agr(:,:,:) = 0. 
    348356         Agrif_SpecialValue=-9999. 
    349357         Agrif_UseSpecialValue = .TRUE. 
    350          CALL Agrif_Bc_variable( ztab, adv_ice_id ,procname=interp_adv_ice,calledweight=1. ) 
     358         CALL Agrif_Bc_variable( adv_ice_id ,procname=interp_adv_ice,calledweight=1. ) 
    351359         Agrif_SpecialValue=0. 
    352360         Agrif_UseSpecialValue = .FALSE. 
     
    356364            DO jj = 1, jpj 
    357365               DO ji=1,2 
    358                   adv_ice_oe(ji  ,jj,jn,2) = ztab(ji       ,jj,jn)  
    359                   adv_ice_oe(ji+2,jj,jn,2) = ztab(nlci-2+ji,jj,jn) 
     366                  adv_ice_oe(ji  ,jj,jn,2) = tabice_agr(ji       ,jj,jn)  
     367                  adv_ice_oe(ji+2,jj,jn,2) = tabice_agr(nlci-2+ji,jj,jn) 
    360368               END DO 
    361369            END DO 
     
    365373            Do jj =1,2 
    366374               DO ji = 1, jpi 
    367                   adv_ice_sn(ji,jj  ,jn,2) = ztab(ji,jj       ,jn)  
    368                   adv_ice_sn(ji,jj+2,jn,2) = ztab(ji,nlcj-2+jj,jn) 
     375                  adv_ice_sn(ji,jj  ,jn,2) = tabice_agr(ji,jj       ,jn)  
     376                  adv_ice_sn(ji,jj+2,jn,2) = tabice_agr(ji,nlcj-2+jj,jn) 
    369377               END DO 
    370378            END DO 
     
    384392      INTEGER :: ji,jj,jn 
    385393      REAL(wp) :: zalpha 
    386       REAL(wp), DIMENSION(jpi,jpj,7) :: ztab  
     394      REAL(wp), DIMENSION(jpi,jpj,7) :: tabice_agr  
    387395      !!-----------------------------------------------------------------------       
    388396      ! 
     
    391399      zalpha = REAL(lim_nbstep,wp) / (Agrif_Rhot()*Agrif_PArent(nn_fsbc)/REAL(nn_fsbc)) 
    392400      ! 
    393       ztab(:,:,:) = 0.e0 
     401      tabice_agr(:,:,:) = 0.e0 
    394402      DO jn =1,7 
    395403         DO jj =1,2 
    396404            DO ji = 1, jpi 
    397                ztab(ji,jj        ,jn) = (1-zalpha)*adv_ice_sn(ji,jj  ,jn,1) + zalpha*adv_ice_sn(ji,jj  ,jn,2)  
    398                ztab(ji,nlcj-2+jj ,jn) = (1-zalpha)*adv_ice_sn(ji,jj+2,jn,1) + zalpha*adv_ice_sn(ji,jj+2,jn,2)  
     405               tabice_agr(ji,jj        ,jn) = (1-zalpha)*adv_ice_sn(ji,jj  ,jn,1) + zalpha*adv_ice_sn(ji,jj  ,jn,2)  
     406               tabice_agr(ji,nlcj-2+jj ,jn) = (1-zalpha)*adv_ice_sn(ji,jj+2,jn,1) + zalpha*adv_ice_sn(ji,jj+2,jn,2)  
    399407            END DO 
    400408         END DO 
     
    404412         DO jj = 1, jpj 
    405413            DO ji=1,2 
    406                ztab(ji       ,jj,jn) = (1-zalpha)*adv_ice_oe(ji  ,jj,jn,1) + zalpha*adv_ice_oe(ji  ,jj,jn,2)  
    407                ztab(nlci-2+ji,jj,jn) = (1-zalpha)*adv_ice_oe(ji+2,jj,jn,1) + zalpha*adv_ice_oe(ji+2,jj,jn,2)  
     414               tabice_agr(ji       ,jj,jn) = (1-zalpha)*adv_ice_oe(ji  ,jj,jn,1) + zalpha*adv_ice_oe(ji  ,jj,jn,2)  
     415               tabice_agr(nlci-2+ji,jj,jn) = (1-zalpha)*adv_ice_oe(ji+2,jj,jn,1) + zalpha*adv_ice_oe(ji+2,jj,jn,2)  
    408416            END DO 
    409417         END DO 
    410418      END DO 
    411419      ! 
    412       CALL parcoursT( ztab(:,:, 1), frld  ) 
    413       CALL parcoursT( ztab(:,:, 2), hicif ) 
    414       CALL parcoursT( ztab(:,:, 3), hsnif ) 
    415       CALL parcoursT( ztab(:,:, 4), tbif(:,:,1) ) 
    416       CALL parcoursT( ztab(:,:, 5), tbif(:,:,2) ) 
    417       CALL parcoursT( ztab(:,:, 6), tbif(:,:,3) ) 
    418       CALL parcoursT( ztab(:,:, 7), qstoif ) 
     420      CALL parcoursT( tabice_agr(:,:, 1), frld  ) 
     421      CALL parcoursT( tabice_agr(:,:, 2), hicif ) 
     422      CALL parcoursT( tabice_agr(:,:, 3), hsnif ) 
     423      CALL parcoursT( tabice_agr(:,:, 4), tbif(:,:,1) ) 
     424      CALL parcoursT( tabice_agr(:,:, 5), tbif(:,:,2) ) 
     425      CALL parcoursT( tabice_agr(:,:, 6), tbif(:,:,3) ) 
     426      CALL parcoursT( tabice_agr(:,:, 7), qstoif ) 
    419427      ! 
    420428   END SUBROUTINE agrif_trp_lim2 
     
    499507 
    500508 
    501    SUBROUTINE interp_u_ice( tabres, i1, i2, j1, j2 ) 
     509   SUBROUTINE interp_u_ice( tabres, i1, i2, j1, j2, before ) 
    502510      !!----------------------------------------------------------------------- 
    503511      !!                     *** ROUTINE interp_u_ice *** 
     
    505513      INTEGER, INTENT(in) :: i1, i2, j1, j2 
    506514      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 
     515      LOGICAL, INTENT(in) :: before 
    507516      !! 
    508517      INTEGER :: ji,jj 
     
    510519      ! 
    511520#if defined key_lim2_vp 
    512       DO jj=MAX(j1,2),j2 
    513          DO ji=MAX(i1,2),i2 
    514             IF( tmu(ji,jj) == 0. ) THEN 
    515                tabres(ji,jj) = -9999. 
    516             ELSE 
    517                tabres(ji,jj) = e2f(ji-1,jj-1) * u_ice(ji,jj) 
    518             ENDIF 
    519          END DO 
    520       END DO 
     521      IF( before ) THEN 
     522         DO jj=MAX(j1,2),j2 
     523            DO ji=MAX(i1,2),i2 
     524               IF( tmu(ji,jj) == 0. ) THEN 
     525                  tabres(ji,jj) = -9999. 
     526               ELSE 
     527                  tabres(ji,jj) = e2f(ji-1,jj-1) * u_ice(ji,jj) 
     528               ENDIF 
     529            END DO 
     530         END DO 
     531      ENDIF 
    521532#else 
    522       DO jj= j1, j2 
    523          DO ji= i1, i2 
    524             IF( umask(ji,jj,1) == 0. ) THEN 
    525                tabres(ji,jj) = -9999. 
    526             ELSE 
    527                tabres(ji,jj) = e2u(ji,jj) * u_ice(ji,jj) 
    528             ENDIF 
    529          END DO 
    530       END DO 
     533      IF( before ) THEN 
     534         DO jj= j1, j2 
     535            DO ji= i1, i2 
     536               IF( umask(ji,jj,1) == 0. ) THEN 
     537                  tabres(ji,jj) = -9999. 
     538               ELSE 
     539                  tabres(ji,jj) = e2u(ji,jj) * u_ice(ji,jj) 
     540               ENDIF 
     541            END DO 
     542         END DO 
     543      ENDIF 
    531544#endif 
    532545   END SUBROUTINE interp_u_ice 
    533546 
    534547 
    535    SUBROUTINE interp_v_ice( tabres, i1, i2, j1, j2 ) 
     548   SUBROUTINE interp_v_ice( tabres, i1, i2, j1, j2, before ) 
    536549      !!----------------------------------------------------------------------- 
    537550      !!                    *** ROUTINE interp_v_ice *** 
     
    539552      INTEGER, INTENT(in) :: i1, i2, j1, j2 
    540553      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 
     554      LOGICAL, INTENT(in) :: before 
    541555      !! 
    542556      INTEGER :: ji, jj 
     
    544558      ! 
    545559#if defined key_lim2_vp 
    546       DO jj=MAX(j1,2),j2 
    547          DO ji=MAX(i1,2),i2 
    548             IF( tmu(ji,jj) == 0. ) THEN 
    549                tabres(ji,jj) = -9999. 
    550             ELSE 
    551                tabres(ji,jj) = e1f(ji-1,jj-1) * v_ice(ji,jj) 
    552             ENDIF 
    553          END DO 
    554       END DO 
     560      IF( before ) THEN 
     561         DO jj=MAX(j1,2),j2 
     562            DO ji=MAX(i1,2),i2 
     563               IF( tmu(ji,jj) == 0. ) THEN 
     564                  tabres(ji,jj) = -9999. 
     565               ELSE 
     566                  tabres(ji,jj) = e1f(ji-1,jj-1) * v_ice(ji,jj) 
     567               ENDIF 
     568            END DO 
     569         END DO 
     570      ENDIF    
    555571#else 
    556       DO jj= j1 ,j2 
    557          DO ji = i1, i2 
    558             IF( vmask(ji,jj,1) == 0. ) THEN 
    559                tabres(ji,jj) = -9999. 
    560             ELSE 
    561                tabres(ji,jj) = e1v(ji,jj) * v_ice(ji,jj) 
    562             ENDIF 
    563          END DO 
    564       END DO 
     572      IF( before ) THEN 
     573         DO jj= j1 ,j2 
     574            DO ji = i1, i2 
     575               IF( vmask(ji,jj,1) == 0. ) THEN 
     576                  tabres(ji,jj) = -9999. 
     577               ELSE 
     578                  tabres(ji,jj) = e1v(ji,jj) * v_ice(ji,jj) 
     579               ENDIF 
     580            END DO 
     581         END DO 
     582      ENDIF 
    565583#endif 
    566584   END SUBROUTINE interp_v_ice 
    567585 
    568586 
    569    SUBROUTINE interp_adv_ice( tabres, i1, i2, j1, j2 ) 
     587   SUBROUTINE interp_adv_ice( tabres, i1, i2, j1, j2, before ) 
    570588      !!----------------------------------------------------------------------- 
    571589      !!                    *** ROUTINE interp_adv_ice ***                            
     
    577595      INTEGER, INTENT(in) :: i1, i2, j1, j2 
    578596      REAL(wp), DIMENSION(i1:i2,j1:j2,7), INTENT(inout) :: tabres 
     597      LOGICAL, INTENT(in) :: before 
    579598      !! 
    580599      INTEGER :: ji, jj, jk 
    581600      !!----------------------------------------------------------------------- 
    582601      ! 
    583       DO jj=j1,j2 
    584          DO ji=i1,i2 
    585             IF( tms(ji,jj) == 0. ) THEN 
    586                tabres(ji,jj,:) = -9999.  
    587             ELSE 
    588                tabres(ji,jj, 1) = frld  (ji,jj) 
    589                tabres(ji,jj, 2) = hicif (ji,jj) 
    590                tabres(ji,jj, 3) = hsnif (ji,jj) 
    591                tabres(ji,jj, 4) = tbif  (ji,jj,1) 
    592                tabres(ji,jj, 5) = tbif  (ji,jj,2) 
    593                tabres(ji,jj, 6) = tbif  (ji,jj,3) 
    594                tabres(ji,jj, 7) = qstoif(ji,jj) 
    595             ENDIF 
    596          END DO 
    597       END DO 
     602      IF( before ) THEN 
     603         DO jj=j1,j2 
     604            DO ji=i1,i2 
     605               IF( tms(ji,jj) == 0. ) THEN 
     606                  tabres(ji,jj,:) = -9999.  
     607               ELSE 
     608                  tabres(ji,jj, 1) = frld  (ji,jj) 
     609                  tabres(ji,jj, 2) = hicif (ji,jj) 
     610                  tabres(ji,jj, 3) = hsnif (ji,jj) 
     611                  tabres(ji,jj, 4) = tbif  (ji,jj,1) 
     612                  tabres(ji,jj, 5) = tbif  (ji,jj,2) 
     613                  tabres(ji,jj, 6) = tbif  (ji,jj,3) 
     614                  tabres(ji,jj, 7) = qstoif(ji,jj) 
     615               ENDIF 
     616            END DO 
     617         END DO 
     618      ENDIF 
    598619      ! 
    599620   END SUBROUTINE interp_adv_ice 
Note: See TracChangeset for help on using the changeset viewer.