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 10324 for NEMO/branches/UKMO/dev_r9950_old_tidal_mixing/src/NST/agrif_user.F90 – NEMO

Ignore:
Timestamp:
2018-11-16T16:16:27+01:00 (5 years ago)
Author:
davestorkey
Message:

UKMO/dev_r9950_old_tidal_mixing: Update to be relative to rev 10321 of NEMO4_beta_mirror branch.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/UKMO/dev_r9950_old_tidal_mixing/src/NST/agrif_user.F90

    r9950 r10324  
    11#undef UPD_HIGH   /* MIX HIGH UPDATE */ 
    22#if defined key_agrif 
    3 !!---------------------------------------------------------------------- 
    4 !! NEMO/NST 4.0 , NEMO Consortium (2018) 
    5 !! $Id$ 
    6 !! Software governed by the CeCILL licence (./LICENSE) 
    7 !!---------------------------------------------------------------------- 
     3   !!---------------------------------------------------------------------- 
     4   !! NEMO/NST 4.0 , NEMO Consortium (2018) 
     5   !! $Id$ 
     6   !! Software governed by the CeCILL license (see ./LICENSE) 
     7   !!---------------------------------------------------------------------- 
    88SUBROUTINE agrif_user 
    99END SUBROUTINE agrif_user 
     
    1313 
    1414SUBROUTINE Agrif_InitWorkspace 
    15    !!---------------------------------------------------------------------- 
    16    !!                 *** ROUTINE Agrif_InitWorkspace *** 
    17    !!---------------------------------------------------------------------- 
     15      !!---------------------------------------------------------------------- 
     16      !!                 *** ROUTINE Agrif_InitWorkspace *** 
     17      !!---------------------------------------------------------------------- 
    1818   USE par_oce 
    1919   USE dom_oce 
    2020   USE nemogcm 
    2121   USE mppini 
    22    !! 
    23    IMPLICIT NONE 
    24    !!---------------------------------------------------------------------- 
     22      !! 
     23   IMPLICIT NONE 
     24      !!---------------------------------------------------------------------- 
    2525   ! 
    2626   IF( .NOT. Agrif_Root() ) THEN 
     
    3737 
    3838SUBROUTINE Agrif_InitValues 
    39    !!---------------------------------------------------------------------- 
    40    !!                 *** ROUTINE Agrif_InitValues *** 
    41    !! 
    42    !! ** Purpose :: Declaration of variables to be interpolated 
    43    !!---------------------------------------------------------------------- 
     39      !!---------------------------------------------------------------------- 
     40      !!                 *** ROUTINE Agrif_InitValues *** 
     41      !! 
     42      !! ** Purpose :: Declaration of variables to be interpolated 
     43      !!---------------------------------------------------------------------- 
    4444   USE Agrif_Util 
    4545   USE oce  
     
    5050   !! 
    5151   IMPLICIT NONE 
    52    !!---------------------------------------------------------------------- 
     52      !!---------------------------------------------------------------------- 
    5353   ! 
    5454   CALL nemo_init       !* Initializations of each fine grid 
     
    6969 
    7070SUBROUTINE Agrif_InitValues_cont_dom 
    71    !!---------------------------------------------------------------------- 
    72    !!                 *** ROUTINE Agrif_InitValues_cont *** 
    73    !! 
    74    !! ** Purpose ::   Declaration of variables to be interpolated 
    75    !!---------------------------------------------------------------------- 
     71      !!---------------------------------------------------------------------- 
     72      !!                 *** ROUTINE Agrif_InitValues_cont *** 
     73      !! 
     74      !! ** Purpose ::   Declaration of variables to be interpolated 
     75      !!---------------------------------------------------------------------- 
    7676   USE Agrif_Util 
    7777   USE oce  
     
    8484   ! 
    8585   IMPLICIT NONE 
    86    !!---------------------------------------------------------------------- 
     86      !!---------------------------------------------------------------------- 
    8787   ! 
    8888   ! Declaration of the type of variable which have to be interpolated 
     
    9494 
    9595SUBROUTINE agrif_declare_var_dom 
    96    !!---------------------------------------------------------------------- 
    97    !!                 *** ROUTINE agrif_declare_var *** 
    98    !! 
    99    !! ** Purpose :: Declaration of variables to be interpolated 
    100    !!---------------------------------------------------------------------- 
     96      !!---------------------------------------------------------------------- 
     97      !!                 *** ROUTINE agrif_declare_var *** 
     98      !! 
     99      !! ** Purpose :: Declaration of variables to be interpolated 
     100      !!---------------------------------------------------------------------- 
    101101   USE agrif_util 
    102102   USE par_oce        
     
    106106   ! 
    107107   INTEGER :: ind1, ind2, ind3 
    108    !!---------------------------------------------------------------------- 
    109  
    110    ! 1. Declaration of the type of variable which have to be interpolated 
    111    !--------------------------------------------------------------------- 
     108      !!---------------------------------------------------------------------- 
     109 
     110      ! 1. Declaration of the type of variable which have to be interpolated 
     111      !--------------------------------------------------------------------- 
    112112   ind1 =     nbghostcells 
    113113   ind2 = 1 + nbghostcells 
     
    116116   CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e2v_id) 
    117117 
    118    ! 2. Type of interpolation 
    119    !------------------------- 
     118      ! 2. Type of interpolation 
     119      !------------------------- 
    120120   CALL Agrif_Set_bcinterp( e1u_id, interp1=Agrif_linear, interp2=AGRIF_ppm    ) 
    121121   CALL Agrif_Set_bcinterp( e2v_id, interp1=AGRIF_ppm   , interp2=Agrif_linear ) 
    122122 
    123    ! 3. Location of interpolation 
    124    !----------------------------- 
     123      ! 3. Location of interpolation 
     124      !----------------------------- 
    125125   CALL Agrif_Set_bc(e1u_id,(/0,ind1-1/)) 
    126126   CALL Agrif_Set_bc(e2v_id,(/0,ind1-1/)) 
    127127 
    128    ! 4. Update type 
    129    !---------------  
     128      ! 4. Update type 
     129      !---------------  
    130130# if defined UPD_HIGH 
    131131   CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Full_Weighting) 
     
    140140 
    141141SUBROUTINE Agrif_InitValues_cont 
    142    !!---------------------------------------------------------------------- 
    143    !!                 *** ROUTINE Agrif_InitValues_cont *** 
    144    !! 
    145    !! ** Purpose ::   Declaration of variables to be interpolated 
    146    !!---------------------------------------------------------------------- 
     142      !!---------------------------------------------------------------------- 
     143      !!                 *** ROUTINE Agrif_InitValues_cont *** 
     144      !! 
     145      !! ** Purpose ::   Declaration of variables to be interpolated 
     146      !!---------------------------------------------------------------------- 
    147147   USE agrif_oce_update 
    148148   USE agrif_oce_interp 
     
    161161   LOGICAL :: check_namelist 
    162162   CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3, cl_check4  
    163    !!---------------------------------------------------------------------- 
     163      !!---------------------------------------------------------------------- 
    164164 
    165165   ! 1. Declaration of the type of variable which have to be interpolated 
     
    293293 
    294294SUBROUTINE agrif_declare_var 
    295    !!---------------------------------------------------------------------- 
    296    !!                 *** ROUTINE agrif_declarE_var *** 
    297    !! 
    298    !! ** Purpose :: Declaration of variables to be interpolated 
    299    !!---------------------------------------------------------------------- 
     295      !!---------------------------------------------------------------------- 
     296      !!                 *** ROUTINE agrif_declarE_var *** 
     297      !! 
     298      !! ** Purpose :: Declaration of variables to be interpolated 
     299      !!---------------------------------------------------------------------- 
    300300   USE agrif_util 
    301301   USE agrif_oce 
     
    307307   ! 
    308308   INTEGER :: ind1, ind2, ind3 
    309    !!---------------------------------------------------------------------- 
     309      !!---------------------------------------------------------------------- 
    310310 
    311311   ! 1. Declaration of the type of variable which have to be interpolated 
     
    451451#if defined key_si3 
    452452SUBROUTINE Agrif_InitValues_cont_ice 
    453    !!---------------------------------------------------------------------- 
    454    !!                 *** ROUTINE Agrif_InitValues_cont_ice *** 
    455    !! 
    456    !! ** Purpose :: Initialisation of variables to be interpolated for ice 
    457    !!---------------------------------------------------------------------- 
     453      !!---------------------------------------------------------------------- 
     454      !!                 *** ROUTINE Agrif_InitValues_cont_ice *** 
     455      !! 
     456      !! ** Purpose :: Initialisation of variables to be interpolated for ice 
     457      !!---------------------------------------------------------------------- 
    458458   USE Agrif_Util 
    459459   USE sbc_oce, ONLY : nn_fsbc  ! clem: necessary otherwise Agrif_Parent(nn_fsbc) = nn_fsbc 
     
    465465   ! 
    466466   IMPLICIT NONE 
    467    !!---------------------------------------------------------------------- 
     467      !!---------------------------------------------------------------------- 
    468468   ! 
    469469   ! Declaration of the type of variable which have to be interpolated (parent=>child) 
     
    495495 
    496496SUBROUTINE agrif_declare_var_ice 
    497    !!---------------------------------------------------------------------- 
    498    !!                 *** ROUTINE agrif_declare_var_ice *** 
    499    !! 
    500    !! ** Purpose :: Declaration of variables to be interpolated for ice 
    501    !!---------------------------------------------------------------------- 
     497      !!---------------------------------------------------------------------- 
     498      !!                 *** ROUTINE agrif_declare_var_ice *** 
     499      !! 
     500      !! ** Purpose :: Declaration of variables to be interpolated for ice 
     501      !!---------------------------------------------------------------------- 
    502502   USE Agrif_Util 
    503503   USE ice 
     
    507507   ! 
    508508   INTEGER :: ind1, ind2, ind3 
    509    !!---------------------------------------------------------------------- 
     509      !!---------------------------------------------------------------------- 
    510510   ! 
    511511   ! 1. Declaration of the type of variable which have to be interpolated (parent=>child) 
     
    553553# if defined key_top 
    554554SUBROUTINE Agrif_InitValues_cont_top 
    555    !!---------------------------------------------------------------------- 
    556    !!                 *** ROUTINE Agrif_InitValues_cont_top *** 
    557    !! 
    558    !! ** Purpose :: Declaration of variables to be interpolated 
    559    !!---------------------------------------------------------------------- 
     555      !!---------------------------------------------------------------------- 
     556      !!                 *** ROUTINE Agrif_InitValues_cont_top *** 
     557      !! 
     558      !! ** Purpose :: Declaration of variables to be interpolated 
     559      !!---------------------------------------------------------------------- 
    560560   USE Agrif_Util 
    561561   USE oce  
     
    575575   CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3 
    576576   LOGICAL :: check_namelist 
    577    !!---------------------------------------------------------------------- 
     577      !!---------------------------------------------------------------------- 
    578578 
    579579 
     
    634634 
    635635SUBROUTINE agrif_declare_var_top 
    636    !!---------------------------------------------------------------------- 
    637    !!                 *** ROUTINE agrif_declare_var_top *** 
    638    !! 
    639    !! ** Purpose :: Declaration of TOP variables to be interpolated 
    640    !!---------------------------------------------------------------------- 
     636      !!---------------------------------------------------------------------- 
     637      !!                 *** ROUTINE agrif_declare_var_top *** 
     638      !! 
     639      !! ** Purpose :: Declaration of TOP variables to be interpolated 
     640      !!---------------------------------------------------------------------- 
    641641   USE agrif_util 
    642642   USE agrif_oce 
     
    647647   ! 
    648648   INTEGER :: ind1, ind2, ind3 
    649    !!---------------------------------------------------------------------- 
     649      !!---------------------------------------------------------------------- 
    650650 
    651651   ! 1. Declaration of the type of variable which have to be interpolated 
     
    684684 
    685685SUBROUTINE Agrif_detect( kg, ksizex ) 
    686    !!---------------------------------------------------------------------- 
    687    !!                      *** ROUTINE Agrif_detect *** 
    688    !!---------------------------------------------------------------------- 
     686      !!---------------------------------------------------------------------- 
     687      !!                      *** ROUTINE Agrif_detect *** 
     688      !!---------------------------------------------------------------------- 
    689689   INTEGER, DIMENSION(2) :: ksizex 
    690690   INTEGER, DIMENSION(ksizex(1),ksizex(2)) :: kg  
    691    !!---------------------------------------------------------------------- 
     691      !!---------------------------------------------------------------------- 
    692692   ! 
    693693   RETURN 
     
    697697 
    698698SUBROUTINE agrif_nemo_init 
    699    !!---------------------------------------------------------------------- 
    700    !!                     *** ROUTINE agrif_init *** 
    701    !!---------------------------------------------------------------------- 
     699      !!---------------------------------------------------------------------- 
     700      !!                     *** ROUTINE agrif_init *** 
     701      !!---------------------------------------------------------------------- 
    702702   USE agrif_oce  
    703703   USE agrif_ice 
     
    710710   INTEGER  ::   iminspon 
    711711   NAMELIST/namagrif/ rn_sponge_tra, rn_sponge_dyn, ln_spc_dyn, ln_chk_bathy 
    712    !!-------------------------------------------------------------------------------------- 
     712      !!-------------------------------------------------------------------------------------- 
    713713   ! 
    714714   REWIND( numnam_ref )              ! Namelist namagrif in reference namelist : AGRIF zoom 
     
    747747 
    748748SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob ) 
    749    !!---------------------------------------------------------------------- 
    750    !!                     *** ROUTINE Agrif_InvLoc *** 
    751    !!---------------------------------------------------------------------- 
     749      !!---------------------------------------------------------------------- 
     750      !!                     *** ROUTINE Agrif_InvLoc *** 
     751      !!---------------------------------------------------------------------- 
    752752   USE dom_oce 
    753753   !! 
     
    755755   ! 
    756756   INTEGER :: indglob, indloc, nprocloc, i 
    757    !!---------------------------------------------------------------------- 
     757      !!---------------------------------------------------------------------- 
    758758   ! 
    759759   SELECT CASE( i ) 
     
    768768 
    769769SUBROUTINE Agrif_get_proc_info( imin, imax, jmin, jmax ) 
    770    !!---------------------------------------------------------------------- 
    771    !!                 *** ROUTINE Agrif_get_proc_info *** 
    772    !!---------------------------------------------------------------------- 
     770      !!---------------------------------------------------------------------- 
     771      !!                 *** ROUTINE Agrif_get_proc_info *** 
     772      !!---------------------------------------------------------------------- 
    773773   USE par_oce 
    774774   !! 
     
    777777   INTEGER, INTENT(out) :: imin, imax 
    778778   INTEGER, INTENT(out) :: jmin, jmax 
    779    !!---------------------------------------------------------------------- 
     779      !!---------------------------------------------------------------------- 
    780780   ! 
    781781   imin = nimppt(Agrif_Procrank+1)  ! ????? 
     
    788788 
    789789SUBROUTINE Agrif_estimate_parallel_cost(imin, imax,jmin, jmax, nbprocs, grid_cost) 
    790    !!---------------------------------------------------------------------- 
    791    !!                 *** ROUTINE Agrif_estimate_parallel_cost *** 
    792    !!---------------------------------------------------------------------- 
     790      !!---------------------------------------------------------------------- 
     791      !!                 *** ROUTINE Agrif_estimate_parallel_cost *** 
     792      !!---------------------------------------------------------------------- 
    793793   USE par_oce 
    794794   !! 
     
    799799   INTEGER,  INTENT(in)  :: nbprocs 
    800800   REAL(wp), INTENT(out) :: grid_cost 
    801    !!---------------------------------------------------------------------- 
     801      !!---------------------------------------------------------------------- 
    802802   ! 
    803803   grid_cost = REAL(imax-imin+1,wp)*REAL(jmax-jmin+1,wp) / REAL(nbprocs,wp) 
     
    809809#else 
    810810SUBROUTINE Subcalledbyagrif 
    811    !!---------------------------------------------------------------------- 
    812    !!                   *** ROUTINE Subcalledbyagrif *** 
    813    !!---------------------------------------------------------------------- 
     811      !!---------------------------------------------------------------------- 
     812      !!                   *** ROUTINE Subcalledbyagrif *** 
     813      !!---------------------------------------------------------------------- 
    814814   WRITE(*,*) 'Impossible to be here' 
    815815END SUBROUTINE Subcalledbyagrif 
Note: See TracChangeset for help on using the changeset viewer.