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 6434 for branches/2016/dev_r6409_SIMPLIF_2_usrdef – NEMO

Ignore:
Timestamp:
2016-04-06T17:51:49+02:00 (8 years ago)
Author:
flavoni
Message:

update usr_def module: add explicit inputs and outputs arguments, see ticket 1692

Location:
branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90

    r6422 r6434  
    297297         ELSE 
    298298            IF(lwp) WRITE(numout,*) '          ln_read_cfg CALL user_defined module' 
    299             CALL usr_def_hgr() 
    300             !SF CALL usr_def_hgr( nbench , jp_cfg  ,                    & 
    301             !SF &                 ff,                         & 
    302             !SF &                 glamt  , glamu   , glamv   , glamf   ,         & 
    303             !SF &                 gphit  , gphiu   , gphiv   , gphif   ,         & 
    304             !SF &                 e1t    , e1u     , e1v     , e1f     ,         & 
    305             !SF &                 e2t    , e2u     , e2v     , e2f     ,         &  
    306             !SF &                 e1e2t  , e1e2u   , e1e2v   , e1e2f   ,         &  
    307             !SF &                 e2_e1u , e1_e2v     ) 
    308             ! 
     299            CALL usr_def_hgr( nbench , jp_cfg  ,                    & 
     300            &                 ff,                         & 
     301            &                 glamt  , glamu   , glamv   , glamf   ,         & 
     302            &                 gphit  , gphiu   , gphiv   , gphif   ,         & 
     303            &                 e1t    , e1u     , e1v     , e1f     ,         & 
     304            &                 e2t    , e2u     , e2v     , e2f     ,         &  
     305            &                 e1e2u  , e1e2v   , e2_e1u  , e1_e2v     ) 
    309306         ! 
    310307         ENDIF 
    … …  
    402399         END IF 
    403400         ! 
    404       CASE ( 5 )                     ! beta-plane and rotated domain (gyre configuration) 
    405          ! 
    406          zbeta = 2. * omega * COS( rad * ppgphi0 ) / ra                     ! beta at latitude ppgphi0 
    407          zphi0 = 15._wp                                                     ! latitude of the first row F-points 
    408          zf0   = 2. * omega * SIN( rad * zphi0 )                            ! compute f0 1st point south 
    409          ! 
    410          iff = 0  
    411          CALL hgr_read( ie1e2u_v, iff )    
    412          ff(:,:) = ( zf0 + zbeta * ABS( gphif(:,:) - zphi0 ) * rad * ra )   ! f = f0 +beta* y ( y=0 at south) 
    413          ! 
    414          IF(lwp) THEN 
    415             WRITE(numout,*)  
    416             WRITE(numout,*) '          Beta-plane and rotated domain : ' 
    417             WRITE(numout,*) '          Coriolis parameter varies in this processor from ', ff(nldi,nldj),' to ', ff(nldi,nlej) 
    418          ENDIF 
    419          ! 
    420          IF( lk_mpp ) THEN  
    421             zminff=ff(nldi,nldj) 
    422             zmaxff=ff(nldi,nlej) 
    423             CALL mpp_min( zminff )   ! min over the global domain 
    424             CALL mpp_max( zmaxff )   ! max over the global domain 
    425             IF(lwp) WRITE(numout,*) '          Coriolis parameter varies globally from ', zminff,' to ', zmaxff 
    426          END IF 
    427          ! 
    428401      END SELECT 
    429402 

  • branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/usrdef.F90

    r6422 r6434  
    88 
    99   !!---------------------------------------------------------------------- 
    10    !!   usr_def_hgr       : initialize the horizontal mesh  
     10   !!   usr_def_hgr       : compute the horizontal mesh  
    1111   !!   usr_def_ini       : initial state  
    12    !!   usr_def_sbc       : initialize the surface bounday conditions 
     12   !!   usr_def_sbc       : compute the surface bounday conditions 
    1313   !!   usr_def_xxx       : initialize the xxx 
    1414   !!---------------------------------------------------------------------- 
    15    !SF  first attempt to define a user_defined_module  
    16    !SF  with of NEMO's routines 
    17    !  
    18    !SF    USE dom_oce        ! ocean space and time domain 
    19    !SF    USE par_oce        ! ocean space and time domain 
    20    !SF    USE phycst         ! physical constants 
    21    !SF    USE mppini         ! shared/distributed memory setting (mpp_init routine) 
    22    !SF    USE in_out_manager ! I/O manager 
    23    !SF    USE lib_mpp        ! MPP library 
    24    !SF    USE timing         ! Timing 
    2515   USE step_oce       ! module used in the ocean time stepping module (step.F90) 
     16   USE mppini         ! shared/distributed memory setting (mpp_init routine) 
     17   USE phycst         ! physical constants 
    2618   IMPLICIT NONE 
    2719   PRIVATE 
    … …  
    3729CONTAINS 
    3830 
    39 SUBROUTINE usr_def_hgr() 
    40 !SF without USE : pass all inputs and outputs  
    41 !SF   SUBROUTINE usr_def_hgr( nbench, jp_cfg, pff,    & 
    42 !SF            &              pglamt, pglamu, pglamv, pglamf,     & 
    43 !SF            &              pgphit, pgphiu, pgphiv, pgphif,     &           
    44 !SF            &              pe1t  , pe1u  , pe1v  , pe1f  ,     &  
    45 !SF            &              pe2t  , pe2u  , pe2v  , pe2f  ,     & 
    46 !SF            &              pe1e2t, pe1e2u, pe1e2v, pe1e2f,     & 
    47 !SF            &              pe2_e1u , pe1_e2v                   ) 
     31   SUBROUTINE usr_def_hgr( nbench, jp_cfg, pff,    & 
     32           &              pglamt, pglamu, pglamv , pglamf,     & 
     33           &              pgphit, pgphiu, pgphiv , pgphif,     &           
     34           &              pe1t  , pe1u  , pe1v   , pe1f  ,     &  
     35           &              pe2t  , pe2u  , pe2v   , pe2f  ,     & 
     36           &              pe1e2u, pe1e2v, pe2_e1u, pe1_e2v      ) 
    4837      !!---------------------------------------------------------------------- 
    4938      !!                  ***  ROUTINE usr_def_hgr  *** 
    5039      !! 
    51       !! ** Purpose :   Compute the geographical position (in degre) of the  
    52       !!      model grid-points,  the horizontal scale factors (in meters) and  
     40      !! ** Purpose :   compute the geographical position (in degre) of the  
     41      !!      model grid-points, the horizontal scale factors (in meters) and  
    5342      !!      the Coriolis factor (in s-1). 
    5443      !! 
    55       !! ** Method  :   The geographical position of the model grid-points is 
     44      !! ** Method  :   the geographical position of the model grid-points is 
    5645      !!      defined from analytical functions, fslam and fsphi, the deriva- 
    5746      !!      tives of which gives the horizontal scale factors e1,e2. 
    … …  
    5948      !!      the two horizontal directions (fse1 and fse2), the model grid- 
    6049      !!      point position and scale factors are given by: 
    61       !!         t-point: 
     50      !!          t-point: 
    6251      !!      glamt(i,j) = fslam(i    ,j    )   e1t(i,j) = fse1(i    ,j    ) 
    6352      !!      gphit(i,j) = fsphi(i    ,j    )   e2t(i,j) = fse2(i    ,j    ) 
    64       !!         u-point: 
     53      !!          u-point: 
    6554      !!      glamu(i,j) = fslam(i+1/2,j    )   e1u(i,j) = fse1(i+1/2,j    ) 
    6655      !!      gphiu(i,j) = fsphi(i+1/2,j    )   e2u(i,j) = fse2(i+1/2,j    ) 
    67       !!         v-point: 
     56      !!          v-point: 
    6857      !!      glamv(i,j) = fslam(i    ,j+1/2)   e1v(i,j) = fse1(i    ,j+1/2) 
    6958      !!      gphiv(i,j) = fsphi(i    ,j+1/2)   e2v(i,j) = fse2(i    ,j+1/2) 
    70       !!            f-point: 
     59      !!          f-point: 
    7160      !!      glamf(i,j) = fslam(i+1/2,j+1/2)   e1f(i,j) = fse1(i+1/2,j+1/2) 
    7261      !!      gphif(i,j) = fsphi(i+1/2,j+1/2)   e2f(i,j) = fse2(i+1/2,j+1/2) 
    … …  
    7766      !!                                     +          dj(fsphi) **2 )(i,j) 
    7867      !! 
    79       !!        The coriolis factor is given at z-point by: 
    80       !!                     ff = 2.*omega*sin(gphif)      (in s-1) 
    81       !! 
    82       !!        This routine is given as an example, it must be modified 
     68      !!      The coriolis factor is given at z-point by: 
     69      !!         ff = 2.*omega*sin(gphif)      (in s-1) 
     70      !! 
     71      !!      This routine is given as an example, it must be modified 
    8372      !!      following the user s desiderata. nevertheless, the output as 
    8473      !!      well as the way to compute the model grid-point position and 
    … …  
    10089      !!                Madec, Imbard, 1996, Clim. Dyn. 
    10190      !!---------------------------------------------------------------------- 
    102 !SF   all  varibales needed without using "USE" 
    103 !SF       !!---------------------------------------------------------------------- 
    104 !SF       INTEGER                 , INTENT(in   ) ::   nbench, jp_cfg   ! parameter of namelist for benchmark, and dimension of GYRE 
    105 !SF       REAL(wp), DIMENSION(:,:), INTENT(  out) ::   pff                             !  coriolis factor at f-point  
    106 !SF       REAL(wp), DIMENSION(:,:), INTENT(  out) ::   pglamt, pglamu, pglamv, pglamf !  longitude outputs  
    107 !SF       REAL(wp), DIMENSION(:,:), INTENT(  out) ::   pgphit, pgphiu, pgphiv, pgphif !  latitude outputs 
    108 !SF       REAL(wp), DIMENSION(:,:), INTENT(  out) ::   pe1t, pe1u, pe1v, pe1f   !  horizontal scale factors  
    109 !SF       REAL(wp), DIMENSION(:,:), INTENT(  out) ::   pe2t, pe2u, pe2v, pe2f   !  horizontal scale factors 
    110 !SF       REAL(wp), DIMENSION(:,:), INTENT(  out) ::   pe1e2t, pe1e2u, pe1e2v, pe1e2f   !  horizontal scale factors 
    111 !SF       REAL(wp), DIMENSION(:,:), INTENT(  out) ::   pe2_e1u, pe1_e2v   !  horizontal scale factors 
    112 !SF       !!---------------------------------------------------------------------- 
     91      INTEGER                 , INTENT(in   ) ::   nbench, jp_cfg   ! parameter of namelist for benchmark, and dimension of GYRE 
     92      REAL(wp), DIMENSION(:,:), INTENT(  out) ::   pff              !  coriolis factor at f-point  
     93      REAL(wp), DIMENSION(:,:), INTENT(  out) ::   pglamt, pglamu, pglamv, pglamf !  longitude outputs  
     94      REAL(wp), DIMENSION(:,:), INTENT(  out) ::   pgphit, pgphiu, pgphiv, pgphif !  latitude outputs 
     95      REAL(wp), DIMENSION(:,:), INTENT(  out) ::   pe1t, pe1u, pe1v, pe1f   !  horizontal scale factors  
     96      REAL(wp), DIMENSION(:,:), INTENT(  out) ::   pe2t, pe2u, pe2v, pe2f   !  horizontal scale factors 
     97      REAL(wp), DIMENSION(:,:), INTENT(  out) ::   pe1e2u , pe1e2v    !  horizontal scale factors 
     98      REAL(wp), DIMENSION(:,:), INTENT(  out) ::   pe2_e1u, pe1_e2v   !  horizontal scale factors 
     99       !!---------------------------------------------------------------------- 
    113100      INTEGER  ::   ji, jj               ! dummy loop indices 
    114101      INTEGER  ::   ii0, ii1, ij0, ij1, iff   ! temporary integers 
    … …  
    156143            !glamt(i,j) longitude at T-point 
    157144            !gphit(i,j) latitude at T-point   
    158             glamt(ji,jj) = glam0 + zim05 * ze1deg * zcos_alpha + zjm05 * ze1deg * zsin_alpha 
    159             gphit(ji,jj) = gphi0 - zim05 * ze1deg * zsin_alpha + zjm05 * ze1deg * zcos_alpha 
     145            pglamt(ji,jj) = glam0 + zim05 * ze1deg * zcos_alpha + zjm05 * ze1deg * zsin_alpha 
     146            pgphit(ji,jj) = gphi0 - zim05 * ze1deg * zsin_alpha + zjm05 * ze1deg * zcos_alpha 
    160147            ! 
    161148            !glamu(i,j) longitude at U-point 
    162149            !gphiu(i,j) latitude at U-point 
    163             glamu(ji,jj) = glam0 + zim1  * ze1deg * zcos_alpha + zjm05 * ze1deg * zsin_alpha 
    164             gphiu(ji,jj) = gphi0 - zim1  * ze1deg * zsin_alpha + zjm05 * ze1deg * zcos_alpha 
     150            pglamu(ji,jj) = glam0 + zim1  * ze1deg * zcos_alpha + zjm05 * ze1deg * zsin_alpha 
     151            pgphiu(ji,jj) = gphi0 - zim1  * ze1deg * zsin_alpha + zjm05 * ze1deg * zcos_alpha 
    165152            ! 
    166153            !glamv(i,j) longitude at V-point 
    167154            !gphiv(i,j) latitude at V-point 
    168             glamv(ji,jj) = glam0 + zim05 * ze1deg * zcos_alpha + zjm1  * ze1deg * zsin_alpha 
    169             gphiv(ji,jj) = gphi0 - zim05 * ze1deg * zsin_alpha + zjm1  * ze1deg * zcos_alpha 
     155            pglamv(ji,jj) = glam0 + zim05 * ze1deg * zcos_alpha + zjm1  * ze1deg * zsin_alpha 
     156            pgphiv(ji,jj) = gphi0 - zim05 * ze1deg * zsin_alpha + zjm1  * ze1deg * zcos_alpha 
    170157            !glamf(i,j) longitude at F-point 
    171158            !gphif(i,j) latitude at F-point  
    172             glamf(ji,jj) = glam0 + zim1  * ze1deg * zcos_alpha + zjm1  * ze1deg * zsin_alpha 
    173             gphif(ji,jj) = gphi0 - zim1  * ze1deg * zsin_alpha + zjm1  * ze1deg * zcos_alpha 
     159            pglamf(ji,jj) = glam0 + zim1  * ze1deg * zcos_alpha + zjm1  * ze1deg * zsin_alpha 
     160            pgphif(ji,jj) = gphi0 - zim1  * ze1deg * zsin_alpha + zjm1  * ze1deg * zcos_alpha 
    174161         END DO 
    175162      END DO 
    … …  
    177164      ! Horizontal scale factors (in meters) 
    178165      !                              ====== 
    179       e1t(:,:) =  ze1     ;      e2t(:,:) = ze1 
    180       e1u(:,:) =  ze1     ;      e2u(:,:) = ze1 
    181       e1v(:,:) =  ze1     ;      e2v(:,:) = ze1 
    182       e1f(:,:) =  ze1     ;      e2f(:,:) = ze1 
    183       ! 
    184       e1e2u (:,:) = e1u(:,:) * e2u(:,:)    
    185       e1e2v (:,:) = e1v(:,:) * e2v(:,:)  
    186       ! 
    187       e2_e1u(:,:) = e2u(:,:) / e1u(:,:) 
    188       e1_e2v(:,:) = e1v(:,:) / e2v(:,:) 
     166      pe1t(:,:) =  ze1     ;      pe2t(:,:) = ze1 
     167      pe1u(:,:) =  ze1     ;      pe2u(:,:) = ze1 
     168      pe1v(:,:) =  ze1     ;      pe2v(:,:) = ze1 
     169      pe1f(:,:) =  ze1     ;      pe2f(:,:) = ze1 
     170      ! 
     171      pe1e2u (:,:) = pe1u(:,:) * pe2u(:,:)    
     172      pe1e2v (:,:) = pe1v(:,:) * pe2v(:,:)  
     173      ! 
     174      pe2_e1u(:,:) = pe2u(:,:) / pe1u(:,:) 
     175      pe1_e2v(:,:) = pe1v(:,:) / pe2v(:,:) 
    189176 
    190177      IF( lwp .AND. nn_print >=1 .AND. .NOT.ln_rstart ) THEN      ! Control print : Grid informations (if not restart) 
    … …  
    192179         WRITE(numout,*) '          longitude and e1 scale factors' 
    193180         WRITE(numout,*) '          ------------------------------' 
    194          WRITE(numout,9300) ( ji, glamt(ji,1), glamu(ji,1),   & 
    195             glamv(ji,1), glamf(ji,1),   & 
    196             e1t(ji,1), e1u(ji,1),   & 
    197             e1v(ji,1), e1f(ji,1), ji = 1, jpi,10) 
     181         WRITE(numout,9300) ( ji, pglamt(ji,1), pglamu(ji,1),   & 
     182            pglamv(ji,1), pglamf(ji,1),   & 
     183            pe1t(ji,1), pe1u(ji,1),   & 
     184            pe1v(ji,1), pe1f(ji,1), ji = 1, jpi,10) 
    1981859300     FORMAT( 1x, i4, f8.2,1x, f8.2,1x, f8.2,1x, f8.2, 1x,    & 
    199186            f19.10, 1x, f19.10, 1x, f19.10, 1x, f19.10 ) 
    … …  
    202189         WRITE(numout,*) '          latitude and e2 scale factors' 
    203190         WRITE(numout,*) '          -----------------------------' 
    204          WRITE(numout,9300) ( jj, gphit(1,jj), gphiu(1,jj),   & 
    205             &                     gphiv(1,jj), gphif(1,jj),   & 
    206             &                     e2t  (1,jj), e2u  (1,jj),   & 
    207             &                     e2v  (1,jj), e2f  (1,jj), jj = 1, jpj, 10 ) 
     191         WRITE(numout,9300) ( jj, pgphit(1,jj), pgphiu(1,jj),   & 
     192            &                     pgphiv(1,jj), pgphif(1,jj),   & 
     193            &                     pe2t  (1,jj), pe2u  (1,jj),   & 
     194            &                     pe2v  (1,jj), pe2f  (1,jj), jj = 1, jpj, 10 ) 
    208195      ENDIF 
    209196 
    … …  
    214201      ! beta-plane and rotated domain (gyre configuration) 
    215202      ! 
    216       !SF old zbeta = 2. * omega * COS( rad * ppgphi0 ) / ra                     ! beta at latitude ppgphi0 
     203      !SF old ppsphi0: not more necessary?? zbeta = 2. * omega * COS( rad * ppgphi0 ) / ra                     ! beta at latitude ppgphi0 
    217204      zbeta = 2. * omega * COS( rad * gphi0 ) / ra                       ! beta at latitude gphi0 
    218205      zphi0 = 15._wp                                                     ! latitude of the first row F-points 
    219206      zf0   = 2. * omega * SIN( rad * zphi0 )                            ! compute f0 1st point south 
    220207      ! 
    221       ff(:,:) = ( zf0 + zbeta * ABS( gphif(:,:) - zphi0 ) * rad * ra )   ! f = f0 +beta* y ( y=0 at south) 
     208      pff(:,:) = ( zf0 + zbeta * ABS( pgphif(:,:) - zphi0 ) * rad * ra )   ! f = f0 +beta* y ( y=0 at south) 
    222209      iff = 1 
    223210      ! 
    … …  
    225212         WRITE(numout,*)  
    226213         WRITE(numout,*) '          Beta-plane and rotated domain : ' 
    227          WRITE(numout,*) '          Coriolis parameter varies in this processor from ', ff(nldi,nldj),' to ', ff(nldi,nlej) 
     214         WRITE(numout,*) '          Coriolis parameter varies in this processor from ', pff(nldi,nldj),' to ', pff(nldi,nlej) 
    228215      ENDIF 
    229216      ! 
    230217      IF( lk_mpp ) THEN  
    231          zminff=ff(nldi,nldj) 
    232          zmaxff=ff(nldi,nlej) 
     218         zminff=pff(nldi,nldj) 
     219         zmaxff=pff(nldi,nlej) 
    233220         CALL mpp_min( zminff )   ! min over the global domain 
    234221         CALL mpp_max( zmaxff )   ! max over the global domain 
Note: See TracChangeset for help on using the changeset viewer.