Ignore:
Timestamp:
2017-04-23T09:30:41+02:00 (3 years ago)
Author:
gm
Message:

#1880 (HPC-09): add zdfphy (the ZDF manager) + remove all key_…

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90

    r7646 r7953  
    33  
    44MODULE agrif_opa_update 
     5   !!====================================================================== 
     6   !!                   ***  MODULE  agrif_opa_interp  *** 
     7   !! AGRIF: interpolation package 
     8   !!====================================================================== 
     9   !! History :  2.0  !  2002-06  (XXX)  Original cade 
     10   !!             -   !  2005-11  (XXX)  
     11   !!            3.2  !  2009-04  (R. Benshila)  
     12   !!            3.6  !  2014-09  (R. Benshila)  
     13   !!---------------------------------------------------------------------- 
    514#if defined key_agrif  
     15   !!---------------------------------------------------------------------- 
     16   !!   'key_agrif'                                              AGRIF zoom 
     17   !!---------------------------------------------------------------------- 
    618   USE par_oce 
    719   USE oce 
    820   USE dom_oce 
     21   USE zdf_oce        ! vertical physics: ocean variables  
    922   USE agrif_oce 
    10    USE in_out_manager  ! I/O manager 
     23   ! 
     24   USE in_out_manager ! I/O manager 
    1125   USE lib_mpp 
    1226   USE wrk_nemo   
    13    USE zdf_oce        ! vertical physics: ocean variables  
    1427 
    1528   IMPLICIT NONE 
    1629   PRIVATE 
    1730 
    18    PUBLIC Agrif_Update_Tra, Agrif_Update_Dyn,Update_Scales 
    19 # if defined key_zdftke 
    20    PUBLIC Agrif_Update_Tke 
    21 # endif 
     31   PUBLIC   Agrif_Update_Tra, Agrif_Update_Dyn, Update_Scales 
     32   PUBLIC   Agrif_Update_Tke 
     33 
    2234   !!---------------------------------------------------------------------- 
    23    !! NEMO/NST 3.6 , NEMO Consortium (2010) 
     35   !! NEMO/NST 4.0 , NEMO Consortium (2017) 
    2436   !! $Id$ 
    2537   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     
    2840 
    2941   RECURSIVE SUBROUTINE Agrif_Update_Tra( ) 
    30       !!--------------------------------------------- 
    31       !!   *** ROUTINE Agrif_Update_Tra *** 
    32       !!--------------------------------------------- 
     42      !!---------------------------------------------------------------------- 
     43      !!                   *** ROUTINE Agrif_Update_Tra *** 
     44      !!---------------------------------------------------------------------- 
    3345      !  
    3446      IF (Agrif_Root()) RETURN 
     
    3850 
    3951      Agrif_UseSpecialValueInUpdate = .TRUE. 
    40       Agrif_SpecialValueFineGrid = 0. 
     52      Agrif_SpecialValueFineGrid    = 0._wp 
    4153      !  
    4254      IF (MOD(nbcline,nbclineupdate) == 0) THEN 
     
    6880 
    6981   RECURSIVE SUBROUTINE Agrif_Update_Dyn( ) 
    70       !!--------------------------------------------- 
    71       !!   *** ROUTINE Agrif_Update_Dyn *** 
    72       !!--------------------------------------------- 
     82      !!---------------------------------------------------------------------- 
     83      !!                   *** ROUTINE Agrif_Update_Dyn *** 
     84      !!---------------------------------------------------------------------- 
    7385      !  
    7486      IF (Agrif_Root()) RETURN 
     
    106118# endif 
    107119 
    108       IF ( ln_dynspg_ts.AND.ln_bt_fw ) THEN 
     120      IF ( ln_dynspg_ts .AND. ln_bt_fw ) THEN 
    109121         ! Update time integrated transports 
    110122         IF (mod(nbcline,nbclineupdate) == 0) THEN 
     
    149161   END SUBROUTINE Agrif_Update_Dyn 
    150162 
    151 # if defined key_zdftke 
     163!!gm Missing GLS case !!!!! 
    152164 
    153165   SUBROUTINE Agrif_Update_Tke( kt ) 
    154       !!--------------------------------------------- 
    155       !!   *** ROUTINE Agrif_Update_Tke *** 
    156       !!--------------------------------------------- 
    157       !! 
     166      !!---------------------------------------------------------------------- 
     167      !!                   *** ROUTINE Agrif_Update_Tke *** 
     168      !!---------------------------------------------------------------------- 
    158169      INTEGER, INTENT(in) :: kt 
    159       !        
    160       IF( ( Agrif_NbStepint() .NE. 0 ) .AND. (kt /= 0) ) RETURN 
     170      !!---------------------------------------------------------------------- 
     171      ! 
     172!!gm test on kt/=0  ????  why not nit000-1  ?  doesn't seem logic 
     173      IF( ( Agrif_NbStepint() /= 0 ) .AND. kt /= 0 )   RETURN 
    161174#  if defined TWO_WAY 
    162  
     175      ! 
    163176      Agrif_UseSpecialValueInUpdate = .TRUE. 
    164       Agrif_SpecialValueFineGrid = 0. 
    165  
    166       CALL Agrif_Update_Variable( en_id, locupdate=(/0,0/), procname=updateEN  ) 
    167       CALL Agrif_Update_Variable(avt_id, locupdate=(/0,0/), procname=updateAVT ) 
    168       CALL Agrif_Update_Variable(avm_id, locupdate=(/0,0/), procname=updateAVM ) 
    169  
     177      Agrif_SpecialValueFineGrid    = 0._wp 
     178      ! 
     179      CALL Agrif_Update_Variable(  en_id, locupdate=(/0,0/), procname=updateEN  ) 
     180      CALL Agrif_Update_Variable( avt_id, locupdate=(/0,0/), procname=updateAVT ) 
     181      CALL Agrif_Update_Variable( avm_id, locupdate=(/0,0/), procname=updateAVM ) 
     182      ! 
    170183      Agrif_UseSpecialValueInUpdate = .FALSE. 
    171  
     184      ! 
    172185#  endif 
    173        
     186      ! 
    174187   END SUBROUTINE Agrif_Update_Tke 
    175188    
    176 # endif /* key_zdftke */ 
    177189 
    178190   SUBROUTINE updateTS( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before ) 
    179       !!--------------------------------------------- 
     191      !!---------------------------------------------------------------------- 
    180192      !!           *** ROUTINE updateT *** 
    181       !!--------------------------------------------- 
    182       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 
    183       REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 
    184       LOGICAL, INTENT(in) :: before 
    185       !! 
    186       INTEGER :: ji,jj,jk,jn 
    187       !!--------------------------------------------- 
    188       ! 
    189       IF (before) THEN 
    190          DO jn = n1,n2 
    191             DO jk=k1,k2 
    192                DO jj=j1,j2 
    193                   DO ji=i1,i2 
     193      !!---------------------------------------------------------------------- 
     194      INTEGER                                    , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2, n1, n2 
     195      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) ::   tabres 
     196      LOGICAL                                    , INTENT(in   ) ::  before 
     197      ! 
     198      INTEGER :: ji, jj, jk, jn 
     199      !!---------------------------------------------------------------------- 
     200      ! 
     201      IF( before ) THEN 
     202         DO jn = n1, n2 
     203            DO jk = k1, k2 
     204               DO jj = j1, j2 
     205                  DO ji = i1, i2 
    194206                     tabres(ji,jj,jk,jn) = tsn(ji,jj,jk,jn) 
    195207                  END DO 
     
    209221                                 &             - tsn(ji,jj,jk,jn) ) * tmask(ji,jj,jk) 
    210222                        ENDIF 
    211                      ENDDO 
    212                   ENDDO 
    213                ENDDO 
    214             ENDDO 
     223                     END DO 
     224                  END DO 
     225               END DO 
     226            END DO 
    215227         ENDIF 
    216228         DO jn = n1,n2 
     
    238250      LOGICAL                               , INTENT(in   ) :: before 
    239251      ! 
    240       INTEGER  ::   ji, jj, jk 
    241       REAL(wp) ::   zrhoy 
     252      INTEGER ::   ji, jj, jk 
     253      REAL(wp)::   zrhoy 
    242254      !!--------------------------------------------- 
    243255      !  
     
    268280 
    269281   SUBROUTINE updatev( tabres, i1, i2, j1, j2, k1, k2, before ) 
    270       !!--------------------------------------------- 
    271       !!           *** ROUTINE updatev *** 
    272       !!--------------------------------------------- 
    273       INTEGER :: i1,i2,j1,j2,k1,k2 
    274       INTEGER :: ji,jj,jk 
    275       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: tabres 
    276       LOGICAL :: before 
     282      !!---------------------------------------------------------------------- 
     283      !!                      *** ROUTINE updatev *** 
     284      !!---------------------------------------------------------------------- 
     285      INTEGER                               , INTENT(in   ) :: i1, i2, j1, j2, k1, k2 
     286      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 
     287      LOGICAL                               , INTENT(in   ) :: before 
    277288      !! 
    278       REAL(wp) :: zrhox 
    279       !!---------------------------------------------       
    280       ! 
    281       IF (before) THEN 
     289      INTEGER  ::   ji, jj, jk 
     290      REAL(wp) ::   zrhox 
     291      !!---------------------------------------------------------------------- 
     292      ! 
     293      IF( before ) THEN 
    282294         zrhox = Agrif_Rhox() 
    283295         DO jk=k1,k2 
     
    309321 
    310322   SUBROUTINE updateu2d( tabres, i1, i2, j1, j2, before ) 
     323      !!---------------------------------------------------------------------- 
     324      !!                      *** ROUTINE updateu2d *** 
     325      !!---------------------------------------------------------------------- 
     326      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2 
     327      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   tabres 
     328      LOGICAL                         , INTENT(in   ) ::   before 
     329      !!  
     330      INTEGER ::   ji, jj, jk 
     331      REAL(wp)::   zrhoy, zcorr 
    311332      !!--------------------------------------------- 
    312       !!          *** ROUTINE updateu2d *** 
    313       !!--------------------------------------------- 
    314       INTEGER, INTENT(in) :: i1, i2, j1, j2 
    315       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 
    316       LOGICAL, INTENT(in) :: before 
    317       !!  
    318       INTEGER :: ji, jj, jk 
    319       REAL(wp) :: zrhoy 
    320       REAL(wp) :: zcorr 
    321       !!--------------------------------------------- 
    322       ! 
    323       IF (before) THEN 
     333      ! 
     334      IF( before ) THEN 
    324335         zrhoy = Agrif_Rhoy() 
    325336         DO jj=j1,j2 
     
    374385 
    375386   SUBROUTINE updatev2d( tabres, i1, i2, j1, j2, before ) 
    376       !!--------------------------------------------- 
    377       !!          *** ROUTINE updatev2d *** 
    378       !!--------------------------------------------- 
    379       INTEGER, INTENT(in) :: i1, i2, j1, j2 
    380       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 
    381       LOGICAL, INTENT(in) :: before 
    382       !!  
     387      !!---------------------------------------------------------------------- 
     388      !!                   *** ROUTINE updatev2d *** 
     389      !!---------------------------------------------------------------------- 
     390      INTEGER                         , INTENT(in   ) ::  i1, i2, j1, j2 
     391      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   tabres 
     392      LOGICAL                         , INTENT(in   ) ::  before 
     393      !  
    383394      INTEGER :: ji, jj, jk 
    384       REAL(wp) :: zrhox 
    385       REAL(wp) :: zcorr 
    386       !!--------------------------------------------- 
    387       ! 
    388       IF (before) THEN 
     395      REAL(wp) :: zrhox, zcorr 
     396      !!---------------------------------------------------------------------- 
     397      ! 
     398      IF( before ) THEN 
    389399         zrhox = Agrif_Rhox() 
    390400         DO jj=j1,j2 
     
    439449 
    440450   SUBROUTINE updateSSH( tabres, i1, i2, j1, j2, before ) 
    441       !!--------------------------------------------- 
    442       !!          *** ROUTINE updateSSH *** 
    443       !!--------------------------------------------- 
    444       INTEGER, INTENT(in) :: i1, i2, j1, j2 
    445       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 
    446       LOGICAL, INTENT(in) :: before 
     451      !!---------------------------------------------------------------------- 
     452      !!                   *** ROUTINE updateSSH *** 
     453      !!---------------------------------------------------------------------- 
     454      INTEGER                         , INTENT(in   ) ::  i1, i2, j1, j2 
     455      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   tabres 
     456      LOGICAL                         , INTENT(in   ) ::  before 
    447457      !! 
    448458      INTEGER :: ji, jj 
    449       !!--------------------------------------------- 
    450       !  
    451       IF (before) THEN 
     459      !!---------------------------------------------------------------------- 
     460      !  
     461      IF( before ) THEN 
    452462         DO jj=j1,j2 
    453463            DO ji=i1,i2 
     
    478488 
    479489   SUBROUTINE updateub2b( tabres, i1, i2, j1, j2, before ) 
    480       !!--------------------------------------------- 
    481       !!          *** ROUTINE updateub2b *** 
    482       !!--------------------------------------------- 
    483       INTEGER, INTENT(in) :: i1, i2, j1, j2 
    484       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 
    485       LOGICAL, INTENT(in) :: before 
     490      !!---------------------------------------------------------------------- 
     491      !!                      *** ROUTINE updateub2b *** 
     492      !!---------------------------------------------------------------------- 
     493      INTEGER                            , INTENT(in) ::  i1, i2, j1, j2 
     494      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   tabres 
     495      LOGICAL                            , INTENT(in) ::  before 
    486496      !! 
    487       INTEGER :: ji, jj 
    488       REAL(wp) :: zrhoy 
    489       !!--------------------------------------------- 
     497      INTEGER ::   ji, jj 
     498      REAL(wp)::  zrhoy 
     499      !!---------------------------------------------------------------------- 
    490500      ! 
    491501      IF (before) THEN 
     
    509519 
    510520   SUBROUTINE updatevb2b( tabres, i1, i2, j1, j2, before ) 
    511       !!--------------------------------------------- 
    512       !!          *** ROUTINE updatevb2b *** 
    513       !!--------------------------------------------- 
    514       INTEGER, INTENT(in) :: i1, i2, j1, j2 
    515       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 
    516       LOGICAL, INTENT(in) :: before 
     521      !!---------------------------------------------------------------------- 
     522      !!                      *** ROUTINE updatevb2b *** 
     523      !!---------------------------------------------------------------------- 
     524      INTEGER                         , INTENT(in   ) ::  i1, i2, j1, j2 
     525      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   tabres 
     526      LOGICAL                         , INTENT(in   ) ::  before 
    517527      !! 
    518       INTEGER :: ji, jj 
    519       REAL(wp) :: zrhox 
    520       !!--------------------------------------------- 
    521       ! 
    522       IF (before) THEN 
     528      INTEGER ::   ji, jj 
     529      REAL(wp)::  zrhox 
     530      !!---------------------------------------------------------------------- 
     531      ! 
     532      IF( before ) THEN 
    523533         zrhox = Agrif_Rhox() 
    524534         DO jj=j1,j2 
     
    540550 
    541551   SUBROUTINE update_scales( tabres, i1, i2, j1, j2, k1, k2, n1,n2, before ) 
    542       ! currently not used 
    543       !!--------------------------------------------- 
    544       !!           *** ROUTINE updateT *** 
    545       !!--------------------------------------------- 
    546       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 
    547       REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 
    548       LOGICAL, iNTENT(in) :: before 
    549       ! 
     552      ! 
     553      ! ====>>>>>>>>>>    currently not used 
     554      ! 
     555      !!---------------------------------------------------------------------- 
     556      !!                      *** ROUTINE updateT *** 
     557      !!---------------------------------------------------------------------- 
     558      INTEGER                                    , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2, n1, n2 
     559      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) ::   tabres 
     560      LOGICAL                                    , INTENT(in   ) ::   before 
     561      !! 
    550562      INTEGER :: ji,jj,jk 
    551563      REAL(wp) :: ztemp 
    552       !!--------------------------------------------- 
     564      !!---------------------------------------------------------------------- 
    553565 
    554566      IF (before) THEN 
     
    587599   END SUBROUTINE update_scales 
    588600 
    589 # if defined key_zdftke 
    590601 
    591602   SUBROUTINE updateEN( ptab, i1, i2, j1, j2, k1, k2, before ) 
    592       !!--------------------------------------------- 
    593       !!           *** ROUTINE updateen *** 
    594       !!--------------------------------------------- 
    595       INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2 
    596       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 
    597       LOGICAL, INTENT(in) :: before 
    598       !!--------------------------------------------- 
    599       ! 
    600       IF (before) THEN 
     603      !!---------------------------------------------------------------------- 
     604      !!                      *** ROUTINE updateen *** 
     605      !!---------------------------------------------------------------------- 
     606      INTEGER                               , INTENT(in   ) ::  i1, i2, j1, j2, k1, k2 
     607      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) ::   ptab 
     608      LOGICAL                               , INTENT(in   ) ::  before 
     609      !!---------------------------------------------------------------------- 
     610      ! 
     611      IF( before ) THEN 
    601612         ptab (i1:i2,j1:j2,k1:k2) = en(i1:i2,j1:j2,k1:k2) 
    602613      ELSE 
     
    608619 
    609620   SUBROUTINE updateAVT( ptab, i1, i2, j1, j2, k1, k2, before ) 
    610       !!--------------------------------------------- 
    611       !!           *** ROUTINE updateavt *** 
    612       !!--------------------------------------------- 
    613       INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2 
    614       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 
    615       LOGICAL, INTENT(in) :: before 
    616       !!--------------------------------------------- 
    617       ! 
    618       IF (before) THEN 
    619          ptab (i1:i2,j1:j2,k1:k2) = avt_k(i1:i2,j1:j2,k1:k2) 
    620       ELSE 
    621          avt_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2)  
     621      !!---------------------------------------------------------------------- 
     622      !!                      *** ROUTINE updateavt *** 
     623      !!---------------------------------------------------------------------- 
     624      INTEGER                               , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2 
     625      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) ::   ptab 
     626      LOGICAL                               , INTENT(in   ) ::   before 
     627      !!---------------------------------------------------------------------- 
     628      ! 
     629      IF( before ) THEN   ;   ptab (i1:i2,j1:j2,k1:k2) = avt_k(i1:i2,j1:j2,k1:k2) 
     630      ELSE                ;   avt_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2)  
    622631      ENDIF 
    623632      ! 
     
    628637      !!--------------------------------------------- 
    629638      !!           *** ROUTINE updateavm *** 
    630       !!--------------------------------------------- 
    631       INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2 
    632       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 
    633       LOGICAL, INTENT(in) :: before 
    634       !!--------------------------------------------- 
    635       ! 
    636       IF (before) THEN 
    637          ptab (i1:i2,j1:j2,k1:k2) = avm_k(i1:i2,j1:j2,k1:k2) 
    638       ELSE 
    639          avm_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2)  
     639      !!---------------------------------------------------------------------- 
     640      INTEGER                               , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2 
     641      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) ::   ptab 
     642      LOGICAL                               , INTENT(in   ) ::   before 
     643      !!---------------------------------------------------------------------- 
     644      ! 
     645      IF( before ) THEN   ;   ptab (i1:i2,j1:j2,k1:k2) = avm_k(i1:i2,j1:j2,k1:k2) 
     646      ELSE                ;   avm_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2)  
    640647      ENDIF 
    641648      ! 
    642649   END SUBROUTINE updateAVM 
    643650 
    644 # endif /* key_zdftke */  
    645  
    646651#else 
     652   !!---------------------------------------------------------------------- 
     653   !!   Empty module                                          no AGRIF zoom 
     654   !!---------------------------------------------------------------------- 
    647655CONTAINS 
    648656   SUBROUTINE agrif_opa_update_empty 
    649       !!--------------------------------------------- 
    650       !!   *** ROUTINE agrif_opa_update_empty *** 
    651       !!--------------------------------------------- 
    652657      WRITE(*,*)  'agrif_opa_update : You should not have seen this print! error?' 
    653658   END SUBROUTINE agrif_opa_update_empty 
    654659#endif 
     660 
     661   !!====================================================================== 
    655662END MODULE agrif_opa_update 
    656663 
Note: See TracChangeset for help on using the changeset viewer.