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 636 for trunk/NEMO/NST_SRC/agrif_user.F90 – NEMO

Ignore:
Timestamp:
2007-03-07T14:28:16+01:00 (17 years ago)
Author:
opalod
Message:

nemo_v2_update_008:RB: clean agrif routines and add sponge layer coefficient in namelist

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/NEMO/NST_SRC/agrif_user.F90

    r628 r636  
    11#if defined key_agrif 
    2       SUBROUTINE Agrif_InitWorkspace 
    3 ! 
    4 !     Modules used: 
    5 ! 
    6       Use par_oce 
    7       Use dom_oce 
     2   SUBROUTINE Agrif_InitWorkspace 
     3      !!------------------------------------------ 
     4      !!   *** ROUTINE Agrif_InitWorkspace *** 
     5      !!------------------------------------------  
     6      USE par_oce 
     7      USE dom_oce 
    88      USE Agrif_Util 
    9 ! 
    10 !     Declarations: 
    11 !       
     9 
    1210      IMPLICIT NONE 
    13 ! 
    14 !     Variables       
    15 ! 
    16  
    17 ! 
    18 !     Begin 
    19 ! 
    20       if ( .NOT. Agrif_Root() ) then 
     11       
     12#if defined key_mpp_dyndist 
     13      CHARACTER(len=20) :: namelistname 
     14      INTEGER nummpp 
     15      NAMELIST/nam_mpp_dyndist/jpni,jpnj,jpnij 
     16 
     17      IF (Agrif_Nbstepint() .EQ. 0) THEN 
     18        nummpp = Agrif_Get_Unit() 
     19        namelistname='namelist' 
     20        IF (.NOT. Agrif_Root()) namelistname=TRIM(Agrif_CFixed())//'_namelist' 
     21        OPEN(nummpp,file=namelistname,status='OLD',form='formatted') 
     22        READ (nummpp,nam_mpp_dyndist) 
     23        CLOSE(nummpp) 
     24      ENDIF 
     25#endif 
     26 
     27      IF( .NOT. Agrif_Root() ) THEN 
    2128         jpiglo = nbcellsx + 2 + 2*nbghostcells 
    2229         jpjglo = nbcellsy + 2 + 2*nbghostcells 
    … …  
    3340         nperio = 0 
    3441         jperio = 0 
    35       endif 
    36  
    37  
    38       Return 
    39       End Subroutine Agrif_InitWorkspace 
    40  
    41 ! 
    42       SUBROUTINE Agrif_InitValues 
    43 !     ------------------------------------------------------------------ 
    44 !     You should declare the variable which has to be interpolated here 
    45 !     ----------------------------------------------------------------- 
    46 ! 
    47 !     Modules used: 
    48 !   
     42      ENDIF 
     43 
     44   END SUBROUTINE Agrif_InitWorkspace 
     45 
     46   ! 
     47   SUBROUTINE Agrif_InitValues 
     48      !!------------------------------------------ 
     49      !!   *** ROUTINE Agrif_InitValues *** 
     50      !! 
     51      !! ** Purpose :: Declaration of variables to 
     52      !!               be interpolated 
     53      !!------------------------------------------ 
    4954      USE Agrif_Util 
    50       USE oce 
     55      USE oce  
    5156      USE dom_oce 
    5257      USE opa 
    53 #if   defined key_tradmp   ||   defined key_esopa 
     58      USE sms 
     59#if defined key_tradmp   ||   defined key_esopa 
    5460      USE tradmp 
    5561#endif 
    … …  
    5965      USE ice_oce 
    6066#endif 
    61 #if defined key_passivetrc 
    62      USE agrif_top_update 
    63      USE agrif_top_interp 
    64      USE sms 
    65 #endif 
    6667#if defined key_agrif 
    67      USE agrif_opa_update 
    68      USE agrif_opa_interp 
    69      USE agrif_opa_sponge 
    70 #endif 
    71 ! 
    72 !     Declarations: 
    73 !       
    74       Implicit none 
    75 ! 
    76 !     Variables 
    77 ! 
    78       REAL(wp) tabtemp(jpi,jpj,jpk) 
    79 #if defined key_passivetrc 
    80       REAL(wp) tabtrtemp(jpi,jpj,jpk,jptra) 
    81 #endif 
    82 !  
     68      USE agrif_opa_update 
     69      USE agrif_opa_interp 
     70      USE agrif_opa_sponge 
     71      USE agrif_top_update 
     72      USE agrif_top_interp 
     73#endif 
     74 
     75      IMPLICIT NONE 
     76 
     77      REAL(wp) :: tabtemp(jpi,jpj,jpk) 
     78#if defined key_passivetrc 
     79      REAL(wp) :: tabtrtemp(jpi,jpj,jpk,jptra) 
     80#endif  
    8381      LOGICAL check_namelist 
    84 ! 
    85 ! 
    86 !     Begin 
    87 ! 
     82 
     83      ! 0. Initializations 
     84      !------------------- 
    8885#if defined key_orca_r025 || defined key_orca_r05 || defined key_orca_r2 || defined key_orca_r4 
    89       jp_cfg = -1  ! set special value for jp_cfg on fine grids 
     86      jp_cfg = -1    ! set special value for jp_cfg on fine grids 
    9087      cp_cfg = "default" 
    9188#endif 
    9289 
    9390      Call opa_init  ! Initializations of each fine grid 
    94 ! 
    95 !     Specific fine grid Initializations 
    96 ! 
     91 
     92      ! Specific fine grid Initializations 
    9793#if defined key_tradmp || defined key_esopa 
    98 ! no tracer damping on fine grids 
     94      ! no tracer damping on fine grids 
    9995      lk_tradmp = .FALSE. 
    10096#endif 
    101 !       
    102 !     Declaration of the type of variable which have to be interpolated 
    103 ! 
     97      ! 1. Declaration of the type of variable which have to be interpolated 
     98      !--------------------------------------------------------------------- 
    10499      Call Agrif_Set_type(un,(/1,2,0/),(/2,3,0/)) 
    105100      Call Agrif_Set_type(vn,(/2,1,0/),(/3,2,0/)) 
    … …  
    110105      Call Agrif_Set_type(e1u,(/1,2/),(/2,3/)) 
    111106      Call Agrif_Set_type(e2v,(/2,1/),(/3,2/)) 
    112              
     107 
    113108      Call Agrif_Set_type(tn,(/2,2,0/),(/3,3,0/)) 
    114109      Call Agrif_Set_type(sn,(/2,2,0/),(/3,3,0/))  
    … …  
    116111      Call Agrif_Set_type(tb,(/2,2,0/),(/3,3,0/)) 
    117112      Call Agrif_Set_type(sb,(/2,2,0/),(/3,3,0/))  
    118        
     113 
    119114      Call Agrif_Set_type(ta,(/2,2,0/),(/3,3,0/)) 
    120115      Call Agrif_Set_type(sa,(/2,2,0/),(/3,3,0/))        
    121              
     116 
    122117      Call Agrif_Set_type(sshn,(/2,2/),(/3,3/)) 
    123118      Call Agrif_Set_type(gcb,(/2,2/),(/3,3/)) 
    … …  
    128123      Call Agrif_Set_type(tra,(/2,2,0,0/),(/3,3,0,0/)) 
    129124#endif 
    130  
    131  
    132  
    133 ! 
    134 !     Space directions for each variables 
    135 ! 
     125       
     126      ! 2. Space directions for each variables 
     127      !--------------------------------------- 
    136128      Call Agrif_Set_raf(un,(/'x','y','N'/)) 
    137129      Call Agrif_Set_raf(vn,(/'x','y','N'/)) 
    138        
     130 
    139131      Call Agrif_Set_raf(ua,(/'x','y','N'/)) 
    140132      Call Agrif_Set_raf(va,(/'x','y','N'/)) 
    … …  
    145137      Call Agrif_Set_raf(tn,(/'x','y','N'/)) 
    146138      Call Agrif_Set_raf(sn,(/'x','y','N'/)) 
    147        
     139 
    148140      Call Agrif_Set_raf(tb,(/'x','y','N'/)) 
    149141      Call Agrif_Set_raf(sb,(/'x','y','N'/)) 
    150        
     142 
    151143      Call Agrif_Set_raf(ta,(/'x','y','N'/)) 
    152144      Call Agrif_Set_raf(sa,(/'x','y','N'/))       
    153              
     145 
    154146      Call Agrif_Set_raf(sshn,(/'x','y'/)) 
    155147      Call Agrif_Set_raf(gcb,(/'x','y'/)) 
    … …  
    161153#endif 
    162154 
    163 ! 
    164 !     type of interpolation 
    165  
     155      ! 3. Type of interpolation 
     156      !-------------------------  
    166157      Call Agrif_Set_bcinterp(tn,interp=AGRIF_linear) 
    167158      Call Agrif_Set_bcinterp(sn,interp=AGRIF_linear) 
    168        
     159 
    169160      Call Agrif_Set_bcinterp(ta,interp=AGRIF_linear) 
    170161      Call Agrif_Set_bcinterp(sa,interp=AGRIF_linear) 
    171                 
     162 
    172163      Call Agrif_Set_bcinterp(un,interp1=Agrif_linear,interp2=AGRIF_ppm) 
    173164      Call Agrif_Set_bcinterp(vn,interp1=AGRIF_ppm,interp2=Agrif_linear) 
    … …  
    175166      Call Agrif_Set_bcinterp(ua,interp1=Agrif_linear,interp2=AGRIF_ppm) 
    176167      Call Agrif_Set_bcinterp(va,interp1=AGRIF_ppm,interp2=Agrif_linear) 
    177        
     168 
    178169      Call Agrif_Set_bcinterp(e1u,interp1=Agrif_linear,interp2=AGRIF_ppm) 
    179170      Call Agrif_Set_bcinterp(e2v,interp1=AGRIF_ppm,interp2=Agrif_linear) 
    … …  
    184175#endif 
    185176 
    186 ! 
    187 !     Location of interpolation 
    188 ! 
     177      ! 4. Location of interpolation 
     178      !----------------------------- 
    189179      Call Agrif_Set_bc(un,(/0,1/)) 
    190180      Call Agrif_Set_bc(vn,(/0,1/)) 
    191        
     181 
    192182      Call Agrif_Set_bc(e1u,(/0,0/)) 
    193183      Call Agrif_Set_bc(e2v,(/0,0/)) 
    … …  
    207197#endif 
    208198 
    209 !    Update type 
    210        
     199      ! 5. Update type 
     200      !---------------  
    211201      Call Agrif_Set_Updatetype(tn, update = AGRIF_Update_Average) 
    212202      Call Agrif_Set_Updatetype(sn, update = AGRIF_Update_Average) 
    213        
     203 
    214204      Call Agrif_Set_Updatetype(tb, update = AGRIF_Update_Average) 
    215205      Call Agrif_Set_Updatetype(sb, update = AGRIF_Update_Average) 
    … …  
    229219      Call Agrif_Set_Updatetype(e2v,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy) 
    230220 
    231 ! First interpolations of potentially non zero fields 
    232  
    233        Agrif_SpecialValue=0. 
    234        Agrif_UseSpecialValue = .TRUE. 
    235        Call Agrif_Bc_variable(tabtemp,tn,calledweight=1.) 
    236        Call Agrif_Bc_variable(tabtemp,sn,calledweight=1.) 
    237        Call Agrif_Bc_variable(tabtemp,un,calledweight=1.,procname=interpu) 
    238        Call Agrif_Bc_variable(tabtemp,vn,calledweight=1.,procname=interpv) 
    239  
    240        Call Agrif_Bc_variable(tabtemp,ta,calledweight=1.,procname=interptn) 
    241        Call Agrif_Bc_variable(tabtemp,sa,calledweight=1.,procname=interpsn) 
    242  
    243        Call Agrif_Bc_variable(tabtemp,ua,calledweight=1.,procname=interpun) 
    244        Call Agrif_Bc_variable(tabtemp,va,calledweight=1.,procname=interpvn) 
    245  
    246 #if defined key_passivetrc 
    247        Call Agrif_Bc_variable(tabtrtemp,trn,calledweight=1.) 
    248 !       Call Agrif_Bc_variable(tabtrtemp,tra,calledweight=1.,procname=interptrn) 
    249        Call Agrif_Bc_variable(tabtrtemp,tra,calledweight=1.) 
    250  
    251 #endif 
    252        Agrif_UseSpecialValue = .FALSE. 
    253  
    254 ! 
    255  
    256 ! 
     221      ! 6. First interpolations of potentially non zero fields 
     222      !------------------------------------------------------- 
     223      Agrif_SpecialValue=0. 
     224      Agrif_UseSpecialValue = .TRUE. 
     225      Call Agrif_Bc_variable(tabtemp,tn,calledweight=1.) 
     226      Call Agrif_Bc_variable(tabtemp,sn,calledweight=1.) 
     227      Call Agrif_Bc_variable(tabtemp,un,calledweight=1.,procname=interpu) 
     228      Call Agrif_Bc_variable(tabtemp,vn,calledweight=1.,procname=interpv) 
     229 
     230      Call Agrif_Bc_variable(tabtemp,ta,calledweight=1.,procname=interptn) 
     231      Call Agrif_Bc_variable(tabtemp,sa,calledweight=1.,procname=interpsn) 
     232 
     233      Call Agrif_Bc_variable(tabtemp,ua,calledweight=1.,procname=interpun) 
     234      Call Agrif_Bc_variable(tabtemp,va,calledweight=1.,procname=interpvn) 
     235 
     236#if defined key_passivetrc 
     237      Call Agrif_Bc_variable(tabtrtemp,trn,calledweight=1.) 
     238      Call Agrif_Bc_variable(tabtrtemp,tra,calledweight=1.) 
     239#endif 
     240      Agrif_UseSpecialValue = .FALSE. 
     241 
     242      ! 7. Some controls 
     243      !----------------- 
    257244      check_namelist = .true. 
    258 !       
    259       IF( check_namelist ) then      
    260 ! 
    261 ! check time steps            
    262 ! 
    263        If( nint(Agrif_Rhot()) * nint(rdt) .ne. Agrif_Parent(rdt) ) then 
    264               Write(*,*) 'incompatible time step between grids' 
    265               Write(*,*) 'parent grid value : ',Agrif_Parent(rdt) 
    266               Write(*,*) 'child  grid value : ',nint(rdt) 
    267               Write(*,*) 'value on parent grid should be : ',rdt*Agrif_Rhot() 
    268               stop 
    269        Endif 
    270             
    271        If( Agrif_IRhot() * (Agrif_Parent(nitend)- & 
    272        Agrif_Parent(nit000)+1) .ne. (nitend-nit000+1) ) then 
    273             Write(*,*) 'incompatible run length between grids' 
    274             Write(*,*) 'parent grid value : ',(Agrif_Parent(nitend)- & 
    275             Agrif_Parent(nit000)+1),' time step' 
    276             Write(*,*) 'child  grid value : ', & 
    277             (nitend-nit000+1),' time step' 
    278             Write(*,*) 'value on child grid should be : ', & 
    279             Agrif_IRhot() * (Agrif_Parent(nitend)- & 
    280             Agrif_Parent(nit000)+1) 
    281            stop 
    282        Endif            
    283 ! 
    284 ! 
    285        IF ( ln_zps ) THEN 
    286 ! 
    287 ! check parameters for partial steps  
    288 ! 
    289        If( Agrif_Parent(e3zps_min) .ne. e3zps_min ) then 
    290             Write(*,*) 'incompatible e3zps_min between grids' 
    291             Write(*,*) 'parent grid :',Agrif_Parent(e3zps_min) 
    292             Write(*,*) 'child grid  :',e3zps_min 
    293             Write(*,*) 'those values should be identical' 
    294             stop 
    295        Endif           
    296 !           
    297        If( Agrif_Parent(e3zps_rat) .ne. e3zps_rat ) then 
    298             Write(*,*) 'incompatible e3zps_rat between grids' 
    299             Write(*,*) 'parent grid :',Agrif_Parent(e3zps_rat) 
    300             Write(*,*) 'child grid  :',e3zps_rat 
    301             Write(*,*) 'those values should be identical'                   
    302             stop 
    303        Endif                   
    304        ENDIF 
    305 !             
     245             
     246      IF( check_namelist ) THEN 
     247      
     248         ! Check time steps            
     249         IF( nint(Agrif_Rhot()) * nint(rdt) .ne. Agrif_Parent(rdt) ) THEN 
     250            WRITE(*,*) 'incompatible time step between grids' 
     251            WRITE(*,*) 'parent grid value : ',Agrif_Parent(rdt) 
     252            WRITE(*,*) 'child  grid value : ',nint(rdt) 
     253            WRITE(*,*) 'value on parent grid should be : ',rdt*Agrif_Rhot() 
     254            STOP 
     255         ENDIF 
     256          
     257         ! Check run length 
     258         IF( Agrif_IRhot() * (Agrif_Parent(nitend)- & 
     259            Agrif_Parent(nit000)+1) .ne. (nitend-nit000+1) ) THEN 
     260            WRITE(*,*) 'incompatible run length between grids' 
     261            WRITE(*,*) 'parent grid value : ',(Agrif_Parent(nitend)- & 
     262               Agrif_Parent(nit000)+1),' time step' 
     263            WRITE(*,*) 'child  grid value : ', & 
     264               (nitend-nit000+1),' time step' 
     265            WRITE(*,*) 'value on child grid should be : ', & 
     266               Agrif_IRhot() * (Agrif_Parent(nitend)- & 
     267               Agrif_Parent(nit000)+1) 
     268            STOP 
     269         ENDIF 
     270          
     271         ! Check coordinates 
     272         IF( ln_zps ) THEN 
     273            ! check parameters for partial steps  
     274            IF( Agrif_Parent(e3zps_min) .ne. e3zps_min ) THEN 
     275               WRITE(*,*) 'incompatible e3zps_min between grids' 
     276               WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min) 
     277               WRITE(*,*) 'child grid  :',e3zps_min 
     278               WRITE(*,*) 'those values should be identical' 
     279               STOP 
     280            ENDIF           
     281            IF( Agrif_Parent(e3zps_rat) .ne. e3zps_rat ) THEN 
     282               WRITE(*,*) 'incompatible e3zps_rat between grids' 
     283               WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_rat) 
     284               WRITE(*,*) 'child grid  :',e3zps_rat 
     285               WRITE(*,*) 'those values should be identical'                   
     286               STOP 
     287            ENDIF 
     288         ENDIF 
     289 
    306290      ENDIF 
    307 ! 
    308 ! 
    309  
    310       Call Agrif_Update_tra(0) 
    311       Call Agrif_Update_dyn(0) 
     291 
     292      CALL Agrif_Update_tra(0) 
     293      CALL Agrif_Update_dyn(0) 
     294 
     295      nbcline = 0 
     296 
     297   END SUBROUTINE Agrif_InitValues 
     298   ! 
     299    
     300SUBROUTINE Agrif_detect(g,sizex) 
     301      !!------------------------------------------ 
     302      !!   *** ROUTINE Agrif_detect *** 
     303      !!------------------------------------------ 
     304      USE Agrif_Types 
     305  
     306      INTEGER, DIMENSION(2) :: sizex 
     307      INTEGER, DIMENSION(sizex(1),sizex(2)) :: g  
     308 
     309      Return 
     310 
     311   End SUBROUTINE Agrif_detect 
     312 
     313#if defined key_mpp_mpi 
     314 
     315   SUBROUTINE Agrif_InvLoc(indloc,nprocloc,i,indglob) 
     316      !!------------------------------------------ 
     317      !!   *** ROUTINE Agrif_detect *** 
     318      !!------------------------------------------ 
     319      USE dom_oce 
    312320       
    313       nbcline = 0 
    314  
    315       Return 
    316       End Subroutine Agrif_InitValues 
    317 ! 
    318       SUBROUTINE Agrif_detect(g,sizex) 
    319 ! 
    320 !     Modules used: 
    321 !   
    322       Use Agrif_Types 
    323 ! 
    324 ! 
    325 !     Declarations: 
    326 !       
    327 ! 
    328 !     Variables       
    329 ! 
    330       Integer, Dimension(2) :: sizex 
    331       Integer, Dimension(sizex(1),sizex(2))   :: g  
    332 ! 
    333 !     Begin 
    334 ! 
    335 ! 
    336  
    337 ! 
    338       Return 
    339       End Subroutine Agrif_detect 
    340        
    341 #if defined key_mpp_mpi 
    342 ! 
    343 !     ************************************************************************** 
    344 !!!   Subroutine Agrif_InvLoc 
    345 !     ************************************************************************** 
    346 ! 
    347       Subroutine Agrif_InvLoc(indloc,nprocloc,i,indglob) 
    348 !   
    349 !     Description: 
    350 ! 
    351       USE dom_oce 
    352  
    353 !     Declarations: 
    354 !   
    355 !!      Implicit none 
    356 ! 
    357       Integer :: indglob,indloc,nprocloc,i 
    358 ! 
    359 ! 
     321      IMPLICIT NONE 
     322 
     323      INTEGER :: indglob,indloc,nprocloc,i 
     324 
    360325      SELECT CASE(i) 
    361  
    362326      CASE(1) 
    363         indglob = indloc + nimppt(nprocloc+1) - 1 
    364  
     327         indglob = indloc + nimppt(nprocloc+1) - 1 
    365328      CASE(2) 
    366         indglob = indloc + njmppt(nprocloc+1) - 1  
    367  
     329         indglob = indloc + njmppt(nprocloc+1) - 1  
    368330      CASE(3) 
    369         indglob = indloc 
    370  
     331         indglob = indloc 
    371332      CASE(4) 
    372         indglob = indloc 
    373  
     333         indglob = indloc 
    374334      END SELECT 
    375 ! 
    376 ! 
    377       End Subroutine Agrif_InvLoc 
    378 #endif 
    379  
    380               
     335 
     336   END SUBROUTINE Agrif_InvLoc 
     337 
     338#endif 
     339 
    381340#else 
    382       subroutine Subcalledbyagrif 
    383          write(*,*) 'Impossible to bet here' 
    384       end subroutine Subcalledbyagrif 
    385 #endif 
     341   SUBROUTINE Subcalledbyagrif 
     342      !!------------------------------------------ 
     343      !!   *** ROUTINE Subcalledbyagrif *** 
     344      !!------------------------------------------ 
     345      WRITE(*,*) 'Impossible to be here' 
     346   END SUBROUTINE Subcalledbyagrif 
     347#endif 
Note: See TracChangeset for help on using the changeset viewer.