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 32 – NEMO

Changeset 32


Ignore:
Timestamp:
2004-02-17T10:20:15+01:00 (20 years ago)
Author:
opalod
Message:

CT : UPDATE001 : First major NEMO update

Location:
trunk/NEMO/OPA_SRC
Files:
42 edited

Legend:

Unmodified
Added
Removed

  • trunk/NEMO/OPA_SRC/DIA/diafwb.F90

    r3 r32  
    2929 
    3030   !! * Shared module variables 
    31    LOGICAL, PUBLIC, PARAMETER ::   lk_diafwb = .TRUE.    ! fresh water budget flag 
     31   LOGICAL, PUBLIC, PARAMETER ::   lk_diafwb = .TRUE.    !: fresh water budget flag 
    3232 
    3333   !! * Module variables 
    3434   REAL(wp) ::   & 
    35       a_emp, a_precip, a_rnf,   & 
     35      a_emp , a_precip, a_rnf,   & 
    3636      a_sshb, a_sshn, a_salb, a_saln,   & 
    3737      a_aminus, a_aplus 
    … …  
    8787         ! sshb used because diafwb called after tranxt (i.e. after the swap) 
    8888         a_sshb = SUM( e1t(:,:) * e2t(:,:) * sshb(:,:) * tmask_i(:,:) ) 
     89         IF( lk_mpp )   CALL mpp_sum( a_sshb )      ! sum over the global domain 
    8990 
    9091         DO jk = 1, jpkm1 
    … …  
    9697            END DO 
    9798         END DO 
     99         IF( lk_mpp )   CALL mpp_sum( a_salb )      ! sum over the global domain 
    98100      ENDIF 
    99101       
    100102      a_emp    = SUM( e1t(:,:) * e2t(:,:) * emp   (:,:) * tmask_i(:,:) ) 
     103      IF( lk_mpp )   CALL mpp_sum( a_emp    )       ! sum over the global domain 
    101104#if defined key_flx_bulk_monthly || defined key_flx_bulk_daily 
    102105      a_precip = SUM( e1t(:,:) * e2t(:,:) * watm  (:,:) * tmask_i(:,:) ) 
     106      IF( lk_mpp )   CALL mpp_sum( a_precip )       ! sum over the global domain 
    103107#endif 
    104108      a_rnf    = SUM( e1t(:,:) * e2t(:,:) * runoff(:,:) * tmask_i(:,:) ) 
     109      IF( lk_mpp )   CALL mpp_sum( a_rnf    )       ! sum over the global domain 
    105110 
    106111      IF( aminus /= 0.0 ) a_aminus = a_aminus + ( MIN( aplus, aminus ) / aminus ) 
    107112      IF( aplus  /= 0.0 ) a_aplus  = a_aplus  + ( MIN( aplus, aminus ) / aplus  ) 
    108  
    109 #if defined key_mpp 
    110       ! Mpp: sum over all the global domain 
    111       CALL  mpp_sum( a_sshn )                            !!!!!! bugggggg   a_sshn note befined before!!!!! 
    112 #endif 
    113113 
    114114      IF( kt == nitend ) THEN 
    … …  
    120120         ! Mean sea level at nitend 
    121121         a_sshn = SUM( e1t(:,:) * e2t(:,:) * sshn(:,:) * tmask_i(:,:) ) 
     122         IF( lk_mpp )   CALL mpp_sum( a_sshn )      ! sum over the global domain 
    122123         zarea  = SUM( e1t(:,:) * e2t(:,:) *             tmask_i(:,:) ) 
     124         IF( lk_mpp )   CALL mpp_sum( zarea  )      ! sum over the global domain 
    123125          
    124126         DO jk = 1, jpkm1    
    … …  
    131133            END DO 
    132134         END DO 
    133           
    134          a_aminus = a_aminus/(nitend-nit000+1) 
    135          a_aplus  = a_aplus/(nitend-nit000+1) 
     135         IF( lk_mpp )   CALL mpp_sum( a_saln )      ! sum over the global domain 
     136          
     137         a_aminus = a_aminus / ( nitend - nit000 + 1 ) 
     138         a_aplus  = a_aplus  / ( nitend - nit000 + 1 ) 
    136139 
    137140         ! Conversion in m3 
    … …  
    437440#else 
    438441   !!---------------------------------------------------------------------- 
    439    !!   Default option :                                       Empty Module 
    440    !!---------------------------------------------------------------------- 
    441    LOGICAL, PUBLIC, PARAMETER ::   lk_diafwb = .FALSE.    ! fresh water budget flag 
     442   !!   Default option :                                       Dummy Module 
     443   !!---------------------------------------------------------------------- 
     444   LOGICAL, PUBLIC, PARAMETER ::   lk_diafwb = .FALSE.    !: fresh water budget flag 
    442445CONTAINS 
    443446   SUBROUTINE dia_fwb( kt )        ! Empty routine 
    444       WRITE(*,*) kt                      ! no warning in compilation phase 
     447      WRITE(*,*) 'dia_fwb: : You should not have seen this print! error?', kt 
    445448   END SUBROUTINE dia_fwb 
    446449#endif 

  • trunk/NEMO/OPA_SRC/DIA/diagap.F90

    r3 r32  
    2121 
    2222   IMPLICIT NONE 
     23   PRIVATE 
     24 
     25   !! * Routine accessibility 
     26   PUBLIC dia_gap     ! called in step.F90 module 
    2327 
    2428   !! * Shared module variables 
    25    LOGICAL, PUBLIC, PARAMETER ::   & 
    26       lk_diagap = .TRUE.         ! model-data diagnostics flag 
     29   LOGICAL, PUBLIC, PARAMETER ::   lk_diagap = .TRUE.   !: model-data diagnostics flag 
    2730 
    2831   !! * Module variables 
    2932   INTEGER ::                 & 
    30 !!!   numgap,                 &  ! logical unit for differences diagnostic 
     33!???  numgap,                 &  ! logical unit for differences diagnostic 
    3134      ngap  ,                 &  ! time step frequency 
    3235      nprg                       ! switch for control print 
    … …  
    125128            END DO 
    126129         END DO 
    127 #if defined key_mpp 
    128          CALL mpp_sum( volk, jpk ) 
    129 #endif 
     130         IF( lk_mpp )   CALL mpp_sum( volk, jpk )   ! sum over the global domain 
     131 
    130132         volkr(:) = 0.e0 
    131133         DO jk = 1, jpk 
    … …  
    233235            smodg(jpk) = smodg(jpk) + smodg(jk) * volk(jk) / vol 
    234236         END DO   
    235  
    236 #if defined key_mpp 
    237           CALL mpp_sum( tdtag, jpk ) 
    238           CALL mpp_sum( sdtag, jpk ) 
    239           CALL mpp_sum( tmodg, jpk ) 
    240           CALL mpp_sum( smodg, jpk ) 
    241 #endif 
     237          IF( lk_mpp)   CALL mpp_sum( tdtag, jpk )   ! sum over the global domain 
     238          IF( lk_mpp)   CALL mpp_sum( sdtag, jpk ) 
     239          IF( lk_mpp)   CALL mpp_sum( tmodg, jpk ) 
     240          IF( lk_mpp)   CALL mpp_sum( smodg, jpk ) 
    242241 
    243242          ! 3.  Averaged output in file numgap 
    … …  
    291290#else 
    292291   !!---------------------------------------------------------------------- 
    293    !!   Default option :                                       Empty module 
    294    !!---------------------------------------------------------------------- 
    295    LOGICAL, PUBLIC, PARAMETER ::   lk_diagap = .FALSE.   ! 'key_diagap' flag 
     292   !!   Default option :                                       Dummy module 
     293   !!---------------------------------------------------------------------- 
     294   LOGICAL, PUBLIC, PARAMETER ::   lk_diagap = .FALSE.    !: diagap flag 
    296295CONTAINS 
    297    SUBROUTINE dia_gap( kt )           ! Empty routine 
    298       WRITE(*,*) kt                       ! no warning in compilation phase 
     296   SUBROUTINE dia_gap( kt )           ! Dummy routine 
     297      WRITE(*,*) 'dia_gap: You should not have seen this print! error?', kt 
    299298   END SUBROUTINE dia_gap 
    300299#endif 

  • trunk/NEMO/OPA_SRC/DIA/diahdy.F90

    r3 r32  
    1717 
    1818   IMPLICIT NONE 
     19   PRIVATE 
     20 
     21   !! * Routine accessibility 
     22   PUBLIC dia_hdy     ! called in step.F90 module 
    1923 
    2024   !! * Shared module variables 
    21    LOGICAL, PUBLIC, PARAMETER ::   lk_diahdy = .TRUE.   ! dynamical heigh flag 
     25   LOGICAL, PUBLIC, PARAMETER ::   lk_diahdy = .TRUE.   !: dynamical heigh flag 
    2226 
    2327   !! * Module variables 
    … …  
    6064      !! * Local declarations 
    6165      INTEGER :: ji, jj, jk 
    62       INTEGER :: ihdsup, ik, isup 
     66      INTEGER :: ihdsup, ik 
    6367 
    6468      REAL(wp) :: zgdsup, za, zb, zciint, zfacto, zhd 
    6569      REAL(wp) :: zp, zh, zt, zs, zxk, zq, zsr, zr1, zr2, zr3, zr4 
    66       REAL(wp) :: ze, zbw, zc, zd, zaw, zb1, za1, zkw, zk0, zpval 
     70      REAL(wp) :: ze, zbw, zc, zd, zaw, zb1, za1, zkw, zk0 
    6771      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zsva 
    6872      REAL(wp), DIMENSION(jpk)         :: zwkx, zwky, zwkz 
    … …  
    257261   !!   Default option :                       NO dynamic heigh diagnostics 
    258262   !!---------------------------------------------------------------------- 
    259    LOGICAL, PUBLIC, PARAMETER ::   lk_diahdy = .FALSE.   ! dynamical heigh flag 
     263   LOGICAL, PUBLIC, PARAMETER ::   lk_diahdy = .FALSE.   !: dynamical heigh flag 
    260264CONTAINS 
    261265   SUBROUTINE dia_hdy( kt )               ! Empty routine 
    262       WRITE(*,*) kt 
     266      WRITE(*,*) 'diahdy: You should not have seen this print! error?', kt 
    263267   END SUBROUTINE dia_hdy 
    264268#endif 

  • trunk/NEMO/OPA_SRC/DIA/diahth.F90

    r3 r32  
    2323 
    2424   !! * Shared module variables 
    25    LOGICAL , PUBLIC, PARAMETER ::   & 
    26       lk_diahth = .TRUE.   ! thermocline-20d depths flag 
    27    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   & 
    28       hth  ,      &  ! depth of the max vertical temperature gradient (m) 
    29       hd20 ,      &  ! depth of 20 C isotherm (m) 
    30       hd28 ,      &  ! depth of 28 C isotherm (m) 
    31       htc3           ! heat content of first 300 m 
     25   LOGICAL , PUBLIC, PARAMETER ::   lk_diahth = .TRUE.   !: thermocline-20d depths flag 
     26   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &  !: 
     27      hth  ,      &  !: depth of the max vertical temperature gradient (m) 
     28      hd20 ,      &  !: depth of 20 C isotherm (m) 
     29      hd28 ,      &  !: depth of 28 C isotherm (m) 
     30      htc3           !: heat content of first 300 m 
    3231 
    3332   !! * Substitutions 
    … …  
    210209   !!   Default option :                                       Empty module 
    211210   !!---------------------------------------------------------------------- 
    212    LOGICAL , PUBLIC, PARAMETER ::   & 
    213       lk_diahth = .FALSE.   ! thermocline-20d depths flag 
     211   LOGICAL , PUBLIC, PARAMETER ::   lk_diahth = .FALSE.  !: thermocline-20d depths flag 
    214212CONTAINS 
    215213   SUBROUTINE dia_hth( kt )         ! Empty routine 
    216       WRITE(*,*) kt 
     214      WRITE(*,*) 'dia_hth: You should not have seen this print! error?', kt 
    217215   END SUBROUTINE dia_hth 
    218216#endif 

  • trunk/NEMO/OPA_SRC/DIA/diaspr.F90

    r3 r32  
    3030 
    3131   !! * Shared module variables 
    32    LOGICAL, PUBLIC, PARAMETER ::   lk_diaspr = .TRUE.    ! surface pressure diag. flag 
    33  
    34    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   & 
    35       gps                        ! surface pressure) 
     32   LOGICAL, PUBLIC, PARAMETER ::   lk_diaspr = .TRUE.    !: surface pressure diag. flag 
     33   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   gps         !: surface pressure 
    3634 
    3735   !! * Module variables 
    … …  
    153151            END DO 
    154152         END DO 
    155 #if defined key_mpp 
    156          CALL  mpp_sum( e1e2t ) 
    157 #endif 
     153         IF( lk_mpp )   CALL  mpp_sum( e1e2t )   ! sum over the global domain 
    158154          
    159155         ! build the matrix for the surface pressure 
    … …  
    241237         END DO 
    242238      END DO 
    243 #if defined key_mpp 
    244       CALL  mpp_sum( rnorme ) 
    245 #endif 
     239      IF( lk_mpp )   CALL  mpp_sum( rnorme )   ! sum over the global domain 
     240 
    246241      epsr=eps*eps*rnorme 
    247242      ncut=0 
    … …  
    264259            CALL sol_pcg( nindic )         !   diagonal preconditioned conjuguate gradient 
    265260         ELSE IF ( nsolv == 2 ) THEN 
    266             CALL sol_sor( kt, nindic )     !   successive-over-relaxation 
     261            CALL sol_sor( nindic )     !   successive-over-relaxation 
    267262         ELSE IF(nsolv == 3) THEN 
    268263            CALL sol_fet( nindic )         !   FETI solver 
    … …  
    321316         END DO 
    322317      END DO 
    323 #if defined key_mpp 
    324       CALL  mpp_sum( zpsmea ) 
    325 #endif 
    326       zpsmea=zpsmea/e1e2t 
    327             gps(:,:)=(gps(:,:)-zpsmea)*tmask(:,:,1) 
     318      IF( lk_mpp )   CALL  mpp_sum( zpsmea )   ! sum over the global domain 
     319 
     320      zpsmea = zpsmea / e1e2t 
     321      gps(:,:) = ( gps(:,:) - zpsmea ) * tmask(:,:,1) 
    328322  
    329323      IF(lwp)WRITE(numout,*) ' mean value of ps = ',zpsmea,' is substracted' 
    … …  
    342336      ! compute the max and min error 
    343337       
    344       zemax1=0. 
    345       zemin1=0. 
    346       zemax2=0. 
    347       zemin2=0. 
    348       DO jj=2,jpj-1 
    349          DO ji=2,jpi-1 
    350             z1=ABS( spgum(ji,jj)-gpsuu(ji,jj) )*umask(ji,jj,1) 
    351             z2=ABS( spgvm(ji,jj)-gpsvv(ji,jj) )*vmask(ji,jj,1) 
    352             z3=MAX ( ABS( spgum(ji,jj) ), ABS( spgvm(ji,jj) ) ) 
    353             z4=MAX ( ABS( gpsuu(ji,jj) ), ABS( gpsvv(ji,jj) ) ) 
    354             zemax1=MAX(z1,zemax1) 
    355             zemax2=MAX(z2,zemax2) 
    356             zemin1=MAX(z3,zemin1) 
    357             zemin2=MAX(z4,zemin2) 
    358          END DO 
    359       END DO 
    360 #if defined key_mpp 
    361       CALL  mpp_max( zemax1 ) 
    362       CALL  mpp_max( zemax2 ) 
    363       CALL  mpp_max( zemin1 ) 
    364       CALL  mpp_max( zemin2 ) 
    365 #endif 
     338      zemax1 = 0.e0 
     339      zemin1 = 0.e0 
     340      zemax2 = 0.e0 
     341      zemin2 = 0.e0 
     342      DO jj = 2,jpj-1 
     343         DO ji = 2,jpi-1 
     344            z1 = ABS( spgum(ji,jj)-gpsuu(ji,jj) )*umask(ji,jj,1) 
     345            z2 = ABS( spgvm(ji,jj)-gpsvv(ji,jj) )*vmask(ji,jj,1) 
     346            z3 = MAX ( ABS( spgum(ji,jj) ), ABS( spgvm(ji,jj) ) ) 
     347            z4 = MAX ( ABS( gpsuu(ji,jj) ), ABS( gpsvv(ji,jj) ) ) 
     348            zemax1 = MAX(z1,zemax1) 
     349            zemax2 = MAX(z2,zemax2) 
     350            zemin1 = MAX(z3,zemin1) 
     351            zemin2 = MAX(z4,zemin2) 
     352         END DO 
     353      END DO 
     354      IF( lk_mpp )   CALL  mpp_sum( zemax1 )   ! sum over the global domain 
     355      IF( lk_mpp )   CALL  mpp_sum( zemax2 )   ! sum over the global domain 
     356      IF( lk_mpp )   CALL  mpp_sum( zemin1 )   ! sum over the global domain 
     357      IF( lk_mpp )   CALL  mpp_sum( zemin2 )   ! sum over the global domain 
     358 
    366359      IF(lwp) THEN 
    367360         WRITE(numout,*) 
    … …  
    378371      ! compute the norme and variance of this error 
    379372 
    380       zcompt=0. 
    381       zdif1=0. 
    382       zdif2=0. 
    383       zvar1=0. 
    384       zvar2=0. 
     373      zcompt = 0.e0 
     374      zdif1  = 0.e0 
     375      zdif2  = 0.e0 
     376      zvar1  = 0.e0 
     377      zvar2  = 0.e0 
    385378      DO jj = 2, jpj-1 
    386379         DO ji = 2, jpi-1 
    … …  
    394387         END DO 
    395388      END DO 
    396        
    397 #if defined key_mpp 
    398       CALL mpp_sum( zcompt ) 
    399       CALL mpp_sum( zdif1  ) 
    400       CALL mpp_sum( zdif2  ) 
    401       CALL mpp_sum( zvar1  ) 
    402       CALL mpp_sum( zvar2  ) 
    403 #endif 
     389      IF( lk_mpp )   CALL  mpp_sum( zcompt )   ! sum over the global domain 
     390      IF( lk_mpp )   CALL  mpp_sum( zdif1  )   ! sum over the global domain 
     391      IF( lk_mpp )   CALL  mpp_sum( zdif2  )   ! sum over the global domain 
     392      IF( lk_mpp )   CALL  mpp_sum( zvar1  )   ! sum over the global domain 
     393      IF( lk_mpp )   CALL  mpp_sum( zvar2  )   ! sum over the global domain 
     394 
    404395      IF(lwp) WRITE(numout,*) '        zcompt = ',zcompt 
    405396      zdif1=zdif1/zcompt 
    … …  
    605596   !!   Default option :                    NO surface pressure diagnostics 
    606597   !!---------------------------------------------------------------------- 
    607    LOGICAL, PUBLIC, PARAMETER ::   lk_diaspr = .FALSE.    ! surface pressure diag. flag 
     598   LOGICAL, PUBLIC, PARAMETER ::   lk_diaspr = .FALSE.   !: surface pressure diag. flag 
    608599CONTAINS 
    609600   SUBROUTINE dia_spr( kt )      ! Empty routine 
    610       WRITE(*,*) kt 
     601      WRITE(*,*) 'dia_spr: You should not have seen this print! error?', kt 
    611602   END SUBROUTINE dia_spr 
    612603#endif 

  • trunk/NEMO/OPA_SRC/DIA/diawri_dimg.h90

    r3 r32  
    11  !!---------------------------------------------------------------------- 
    2   !!              ***  diawri_dimg.h90  *** 
     2  !!                        ***  diawri_dimg.h90  *** 
    33  !!---------------------------------------------------------------------- 
    44  !!   OPA 9.0 , LODYC-IPSL  (2003) 
    … …  
    3939    !!    To be tested with a lot of procs !!!! 
    4040    !! 
    41     !!  level 1:  taux(ji,jj) * umask(ji,jj,1) zonal stress in N.m-2 
    42     !!  level 2:  tauy(ji,jj) * vmask(ji,jj,1) meridional stress in N. m-2 
    43     !!  level 3:   q   (ji,jj) + qsr(ji,jj)    total heat flux (W/m2) 
    44     !!  level 4:   emp (ji,jj)              E-P flux (mm/day) 
    45     !!  level 5:  tb  (ji,jj,1)-sst            model SST -forcing sst (degree C) 
    46     !!  level 6:  bsfb(ji,jj)              streamfunction (m**3/s) 
    47     !!  level 7:  qsr (ji,jj)              solar flux (W/m2) 
    48     !!  level 8:  qrp (ji,jj)                  relax component of T flux. 
    49     !!  level 9:  erp (ji,jj)                  relax component of S flux 
    50     !!  level 10: hmld(ji,jj)                   turbocline depth 
    51     !!  level 11: hmlp(ji,jj)                   mixed layer depth 
    52     !!  level 12: freeze (ji,jj)               Ice cover (1. or 0.) 
    53     !!  level 13: sst(ji,jj)                   the observed SST we relax to. 
    54     !!  level 14: qct(ji,jj)                   equivalent flux due to treshold SST 
    55     !!  level 15: fbt(ji,jj)                   feedback term . 
    56     !!  level 16: gps(ji,jj)                   the surface pressure (m). 
    57     !!  level 17: spgu(ji,jj)                  the surface pressure gradient in X direction. 
    58     !!  level 18: spgv(ji,jj)                  the surface pressure gradient in Y direction. 
     41    !!  level 1:  taux(:,:) * umask(:,:,1) zonal stress in N.m-2 
     42    !!  level 2:  tauy(:,:) * vmask(:,:,1) meridional stress in N. m-2 
     43    !!  level 3:   q   (:,:) + qsr(:,:)     total heat flux (W/m2) 
     44    !!  level 4:   emp (:,:)             E-P flux (mm/day) 
     45    !!  level 5:  tb  (:,:,1)-sst            model SST -forcing sst (degree C) 
     46    !!  level 6:  bsfb(:,:)                streamfunction (m**3/s) 
     47    !!  level 7:  qsr (:,:)                solar flux (W/m2) 
     48    !!  level 8:  qrp (:,:)                  relax component of T flux. 
     49    !!  level 9:  erp (:,:)                  relax component of S flux 
     50    !!  level 10: hmld(:,:)                   turbocline depth 
     51    !!  level 11: hmlp(:,:)                   mixed layer depth 
     52    !!  level 12: freeze (:,:)               Ice cover (1. or 0.) 
     53    !!  level 13: sst(:,:)                   the observed SST we relax to. 
     54    !!  level 14: qct(:,:)                   equivalent flux due to treshold SST 
     55    !!  level 15: fbt(:,:)                   feedback term . 
     56    !!  level 16: gps(:,:)                   the surface pressure (m). 
     57    !!  level 17: spgu(:,:)                  the surface pressure gradient in X direction. 
     58    !!  level 18: spgv(:,:)                  the surface pressure gradient in Y direction. 
    5959    !!  
    6060    !! History  
    … …  
    6969    !!---------------------------------------------------------------------- 
    7070    !! * modules used 
     71    USE lib_mpp 
    7172    USE dtasst, ONLY : sst 
    7273 
    … …  
    7677    !! * local declarations 
    7778    INTEGER :: inbsel 
    78     INTEGER :: ji, jj, jk, jl 
    79     INTEGER :: iwrite 
     79!!  INTEGER :: iwrite 
    8080    INTEGER :: iyear,imon,iday 
    8181 
    … …  
    101101    CHARACTER(LEN=80) :: cltext 
    102102    CHARACTER(LEN=80) :: clmode 
    103     CHARACTER(LEN=4) :: clver 
     103    CHARACTER(LEN= 4) :: clver 
    104104    ! 
    105105    !  Initialization 
    … …  
    352352       ENDIF 
    353353 
    354 #ifdef key_mpp 
    355        CALL mppsync 
    356 #endif 
    357        ! 
     354       IF( lk_mpp )   CALL mppsync   ! synchronization in mpp 
    358355 
    359356       !! * Log message in numout  
    … …  
    387384    !!        ***     ROUTINE dia_wri_state  *** 
    388385    !! 
    389     !! ** Purpose : 
    390     !!     Dummy routine for compatibility with IOIPSL output 
     386    !! ** Purpose :   Dummy routine for compatibility with IOIPSL output 
    391387    !! 
    392388    !! ** History : 
    … …  
    394390    !!-------------------------------------------------------------------- 
    395391    !! * Arguments 
    396     CHARACTER (len=*), INTENT(in) :: & 
    397          cdfile_name      ! name of the file created  
    398  
    399     IF (lwp) WRITE(numout) 'dia_wri_state' 
    400     IF (lwp) WRITE(numout) '-------------' 
    401     IF (lwp) WRITE(numout) '      Dummy call to dia_wri_state ' 
     392    CHARACTER (len=*), INTENT(in) ::   cdfile_name   ! name of the file created  
     393    !!-------------------------------------------------------------------- 
     394 
     395    IF (lwp) WRITE(numout,*) 'dia_wri_state: Dummy call', cdfile_name 
     396    IF (lwp) WRITE(numout,*) '-------------' 
     397    IF (lwp) WRITE(numout,*) 
    402398 
    403399  END SUBROUTINE dia_wri_state 
    … …  
    419415    !!   03-12 (J.M. Molines ) : Original. Replace ctlopn, writn2d 
    420416    !!--------------------------------------------------------------------------- 
    421  
    422     !!--------------------------------------------------------------------------- 
    423417    !! * subsitutions 
    424418#  include "domzgr_substitute.h90" 
    425419 
    426420    !! * Arguments 
    427     INTEGER, INTENT(in)            :: klev         ! number of level in ptab to write 
     421    CHARACTER(len=*),INTENT(in) ::   & 
     422         &                            cd_name,  &  ! dimg file name 
     423         &                            cd_text      ! comment to write on record #1 
     424    INTEGER, INTENT(in) ::            klev         ! number of level in ptab to write 
    428425    REAL(wp),INTENT(in), DIMENSION(:,:,:) :: ptab  ! 3D array to write  
    429     CHARACTER(LEN=*),INTENT(in)  :: cd_name,  &    ! dimg file name 
    430          &                            cd_text        ! comment to write on record #1 
    431     CHARACTER(LEN=1),INTENT(in) :: cd_type         ! either 'T', 'W' or '2' , depending on the vertical 
    432     !                                           ! grid for ptab. 2 stands for 2D file 
     426    CHARACTER(LEN=1),INTENT(in) ::    cd_type      ! either 'T', 'W' or '2' , depending on the vertical 
     427    !                                              ! grid for ptab. 2 stands for 2D file 
    433428 
    434429    !! * Local declarations 
    435     INTEGER :: ji,jj,jk,jn              ! dummy loop indices 
     430    INTEGER :: jk, jn           ! dummy loop indices 
    436431    INTEGER :: irecl4,             &    ! record length in bytes 
    437432         &       inum,             &    ! logical unit (set to 14) 
    438433         &       irec                   ! current record to be written 
    439434    REAL(sp)                    :: zdx,zdy,zspval,zwest,ztimm 
    440     REAL(sp)                    :: zsouth,zdtj 
     435    REAL(sp)                    :: zsouth 
    441436    REAL(sp),DIMENSION(jpi,jpj) :: z42d        ! 2d temporary workspace (sp) 
    442437    REAL(sp),DIMENSION(jpk)     :: z4dep       ! vertical level (sp) 
    443438 
    444  
    445439    CHARACTER(LEN=4) :: clver='@!01' 
     440    !!--------------------------------------------------------------------------- 
    446441 
    447442    !! * Initialisations 
    … …  
    471466 
    472467    CASE DEFAULT 
    473        IF (lwp) WRITE(numout,*) ' E R R O R : bad cd_type in dia_wri_dimg ' 
     468       IF(lwp) WRITE(numout,*) ' E R R O R : bad cd_type in dia_wri_dimg ' 
    474469       STOP 'dia_wri_dimg' 
    475470 
    … …  
    480475 
    481476    !! * Write header on record #1 
    482     IF ( lwp ) WRITE(inum,REC=1 ) clver, cd_text, irecl4, & 
     477    IF(lwp) WRITE(inum,REC=1 ) clver, cd_text, irecl4, & 
    483478         &     jpi,jpj, klev*jpnij, 1 , 1 ,            & 
    484479         &     zwest, zsouth, zdx, zdy, zspval,  & 
    … …  
    490485    !! * Write klev levels 
    491486    DO jk = 1, klev 
    492        irec =1 + klev * (narea -1) +jk 
     487       irec =1 + klev * (narea -1) + jk 
    493488       z42d(:,:) = ptab(:,:,jk) 
    494489       WRITE(inum,REC=irec)  z42d(:,:) 
    … …  
    498493    CLOSE(inum) 
    499494 
    500     !! Rather simpler than IOIPSL isn't it ? :) 
    501  
    502495  END SUBROUTINE dia_wri_dimg 

  • trunk/NEMO/OPA_SRC/DOM/closea.F90

    r3 r32  
    2626 
    2727   !! * Share module variables 
    28    INTEGER, PUBLIC, PARAMETER ::   & 
    29       jpncs   = 4               ! number of closed sea 
    30    INTEGER, PUBLIC ::          & !!! namclo : closed seas and lakes 
    31       nclosea =  0                ! = 0 no closed sea or lake 
    32       !                           ! = 1 closed sea or lake in the domain 
    33    INTEGER, PUBLIC, DIMENSION (jpncs) ::   & 
    34       ncstt,           &  ! Type of closed sea 
    35       ncsi1, ncsj1,    &  ! closed sea limits                                                                  
    36       ncsi2, ncsj2,    &  ! 
    37       ncsnr               ! number of point where run-off pours 
     28   INTEGER, PUBLIC, PARAMETER ::   &  !: 
     29      jpncs   = 4               !: number of closed sea 
     30   INTEGER, PUBLIC ::          & !!: namclo : closed seas and lakes 
     31      nclosea =  0                !: = 0 no closed sea or lake 
     32      !                           !  = 1 closed sea or lake in the domain 
     33   INTEGER, PUBLIC, DIMENSION (jpncs) ::   &  !: 
     34      ncstt,           &  !: Type of closed sea 
     35      ncsi1, ncsj1,    &  !: closed sea limits                                                                  
     36      ncsi2, ncsj2,    &  !:  
     37      ncsnr               !: number of point where run-off pours 
    3838   INTEGER, PUBLIC, DIMENSION (jpncs,4) ::   & 
    39       ncsir, ncsjr        ! Location of run-off 
     39      ncsir, ncsjr        !: Location of run-off 
    4040 
    4141   !! * Module variable 
    … …  
    216216            ENDIF  
    217217         END DO  
    218  
    219 #   if defined key_mpp 
    220          ! Mpp: sum over all the global domain 
    221          CALL mpp_sum ( surf, jpncs+1 ) 
    222 #   endif 
     218         IF( lk_mpp )   CALL mpp_sum ( surf, jpncs+1 )       ! mpp: sum over all the global domain 
    223219 
    224220         IF(lwp) WRITE(numout,*)'     Closed sea surfaces' 
    … …  
    246242         END DO  
    247243      END DO 
    248 #   if defined key_mpp 
    249       ! Mpp: sum over all the global domain 
    250       CALL mpp_sum ( zemp , jpncs ) 
    251 #   endif 
     244      IF( lk_mpp )   CALL mpp_sum ( zemp , jpncs )       ! mpp: sum over all the global domain 
    252245 
    253246      IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN      ! Black Sea case for ORCA_R2 configuration 

  • trunk/NEMO/OPA_SRC/DOM/dom_oce.F90

    r3 r32  
    1111 
    1212   IMPLICIT NONE 
    13    PUBLIC 
     13   PUBLIC           ! allows the acces to par_oce when dom_oce is used 
     14   !                ! exception to coding rules... to be suppressed ??? 
    1415 
    1516   !!---------------------------------------------------------------------- 
    1617   !! space domain parameters 
    1718   !! ----------------------- 
    18    LOGICAL ::   & 
    19       lclosea    =  .FALSE. ,   &  ! closed sea flag 
    20       lzoom      =  .FALSE. ,   &  ! zoom flag 
    21       lzoom_e    =  .FALSE. ,   &  ! East  zoom type flag 
    22       lzoom_w    =  .FALSE. ,   &  ! West  zoom type flag 
    23       lzoom_s    =  .FALSE. ,   &  ! South zoom type flag 
    24       lzoom_n    =  .FALSE. ,   &  ! North zoom type flag 
    25       lzoom_arct =  .FALSE. ,   &  ! ORCA    arctic zoom flag 
    26       lzoom_anta =  .FALSE.        ! ORCA antarctic zoom flag 
     19   LOGICAL, PUBLIC ::   &   !: 
     20      lclosea    =  .FALSE. ,   &  !: closed sea flag 
     21      lzoom      =  .FALSE. ,   &  !: zoom flag 
     22      lzoom_e    =  .FALSE. ,   &  !: East  zoom type flag 
     23      lzoom_w    =  .FALSE. ,   &  !: West  zoom type flag 
     24      lzoom_s    =  .FALSE. ,   &  !: South zoom type flag 
     25      lzoom_n    =  .FALSE. ,   &  !: North zoom type flag 
     26      lzoom_arct =  .FALSE. ,   &  !: ORCA    arctic zoom flag 
     27      lzoom_anta =  .FALSE.        !: ORCA antarctic zoom flag 
    2728 
    28    INTEGER ::          & !!! namdom : space domain (bathymetry, mesh) 
    29       ntopo   =  0 ,   &  ! = 0/1 ,compute/read the bathymetry file 
    30       ngrid   =  0 ,   &  ! = 0/1, compute/read the horizontal mesh file 
    31       nmsh    =  0        ! = 1 create a mesh-mask file 
     29   INTEGER, PUBLIC ::           & !!: namdom : space domain (bathymetry, mesh) 
     30      ntopo   =  0 ,            &  !: = 0/1 ,compute/read the bathymetry file 
     31      ngrid   =  0 ,            &  !: = 0/1, compute/read the horizontal mesh file 
     32      nmsh    =  0                 !: = 1 create a mesh-mask file 
    3233 
    33    INTEGER ::         & 
     34   INTEGER, PUBLIC ::         &   !: 
    3435      ! domain parameters linked to mpp 
    35       nperio,          &  ! type of lateral boundary condition 
    36       nimpp, njmpp,    &  ! i- & j-indexes for mpp-subdomain left bottom 
    37       nreci, nrecj,    &  ! overlap region in i and j 
    38       nproc,           &  ! number for local processor 
    39       narea,           &  ! number for local area 
    40       nbondi, nbondj,  &  ! mark of i- and j-direction local boundaries 
    41       npolj,           &  ! north fold mark (0, 3 or 4) 
    42       nlci, nlcj,      &  ! i- & j-dimensions of the local subdomain 
    43       nldi, nlei,      &  ! first and last indoor i- and j-indexes 
    44       nldj, nlej,      &  ! 
    45       noea, nowe,      &  ! index of the local neighboring processors in 
    46       noso, nono,      &  ! east, west, south and north directions 
    47       npne, npnw,      &  ! index of north east and north west processor 
    48       npse, npsw,      &  ! index of south east and south west processor 
    49       nbne, nbnw,      &  ! logical of north east & north west processor 
    50       nbse, nbsw          ! logical of south east & south west processor 
     36      nperio,          &  !: type of lateral boundary condition 
     37      nimpp, njmpp,    &  !: i- & j-indexes for mpp-subdomain left bottom 
     38      nreci, nrecj,    &  !: overlap region in i and j 
     39      nproc,           &  !: number for local processor 
     40      narea,           &  !: number for local area 
     41      nbondi, nbondj,  &  !: mark of i- and j-direction local boundaries 
     42      npolj,           &  !: north fold mark (0, 3 or 4) 
     43      nlci, nlcj,      &  !: i- & j-dimensions of the local subdomain 
     44      nldi, nlei,      &  !: first and last indoor i- and j-indexes 
     45      nldj, nlej,      &  !: 
     46      noea, nowe,      &  !: index of the local neighboring processors in 
     47      noso, nono,      &  !: east, west, south and north directions 
     48      npne, npnw,      &  !: index of north east and north west processor 
     49      npse, npsw,      &  !: index of south east and south west processor 
     50      nbne, nbnw,      &  !: logical of north east & north west processor 
     51      nbse, nbsw          !: logical of south east & south west processor 
    5152 
    52    INTEGER, DIMENSION(jpi) ::   & 
    53       mig                 ! local  ==> global  domain i-indice 
    54    INTEGER, DIMENSION(jpj) ::   & 
    55       mjg                 ! local  ==> global  domain j-indice 
    56    INTEGER, DIMENSION( jpiglo ) ::   &  !!bug ==> other solution? 
    57       mi0, mi1            ! global ==> local domain i-indice 
    58       !                   ! (mi0=1 and mi1=0 if the global indice is not in the local domain) 
    59    INTEGER, DIMENSION( jpjglo ) ::   & 
    60       mj0, mj1            ! global ==> local domain j-indice 
     53   INTEGER, PUBLIC, DIMENSION(jpi) ::   &   !: 
     54      mig                 !: local  ==> global  domain i-indice 
     55   INTEGER, PUBLIC, DIMENSION(jpj) ::   &   !: 
     56      mjg                 !: local  ==> global  domain j-indice 
     57   INTEGER, PUBLIC, DIMENSION( jpiglo ) ::   &  !:  !!bug ==> other solution? 
     58      mi0, mi1            !: global ==> local domain i-indice 
     59      !                   !  (mi0=1 and mi1=0 if the global indice is not in the local domain) 
     60   INTEGER, PUBLIC, DIMENSION( jpjglo ) ::   &  !: 
     61      mj0, mj1            !: global ==> local domain j-indice 
    6162      !                   ! (mi0=1 and mi1=0 if the global indice is not in the local domain) 
    6263 
    63    INTEGER, DIMENSION(jpnij) ::   & 
    64       nimppt, njmppt,  &  ! i-, j-indexes for each processor 
    65       nlcit, nlcjt,    &  ! dimensions of every subdomain 
    66       nldit, nldjt,    &  ! first, last indoor index for each i-domain 
    67       nleit, nlejt        ! first, last indoor index for each j-domain 
     64   INTEGER, PUBLIC, DIMENSION(jpnij) ::   &  !: 
     65      nimppt, njmppt,  &  !: i-, j-indexes for each processor 
     66      nlcit, nlcjt,    &  !: dimensions of every subdomain 
     67      nldit, nldjt,    &  !: first, last indoor index for each i-domain 
     68      nleit, nlejt        !: first, last indoor index for each j-domain 
    6869 
    6970   !!---------------------------------------------------------------------- 
    … …  
    7172   !! --------------------------------------------------------------------- 
    7273 
    73    REAL(wp), DIMENSION(jpi,jpj) ::   & 
    74       glamt, glamu,    &  ! longitude of t-, u-, v- and f-points (degre) 
    75       glamv, glamf,    &  ! 
    76       gphit, gphiu,    &  ! latitude  of t-, u-, v- and f-points (degre) 
    77       gphiv, gphif,    &  ! 
    78       e1t, e2t,        &  ! horizontal scale factors at t-point (m) 
    79       e1u, e2u,        &  ! horizontal scale factors at u-point (m) 
    80       e1v, e2v,        &  ! horizontal scale factors at v-point (m) 
    81       e1f, e2f,        &  ! horizontal scale factors at f-point (m) 
    82       ff                  ! coriolis factor (2.*omega*sin(yphi) ) (s-1) 
     74   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &  !: 
     75      glamt, glamu,    &  !: longitude of t-, u-, v- and f-points (degre) 
     76      glamv, glamf,    &  !: 
     77      gphit, gphiu,    &  !: latitude  of t-, u-, v- and f-points (degre) 
     78      gphiv, gphif,    &  !: 
     79      e1t, e2t,        &  !: horizontal scale factors at t-point (m) 
     80      e1u, e2u,        &  !: horizontal scale factors at u-point (m) 
     81      e1v, e2v,        &  !: horizontal scale factors at v-point (m) 
     82      e1f, e2f,        &  !: horizontal scale factors at f-point (m) 
     83      ff                  !: coriolis factor (2.*omega*sin(yphi) ) (s-1) 
    8384 
    8485   !!---------------------------------------------------------------------- 
    … …  
    8687   !! -------------------------------------- 
    8788 
    88    REAL(wp) ::         & !!! * namelist namdom * 
    89       e3zps_min = 5.0, &  ! miminum thickness for partial steps (meters) 
    90       e3zps_rat = 0.1  ! minimum thickness ration for partial steps 
     89   REAL(wp), PUBLIC ::   & !!: * namelist namdom * 
     90      e3zps_min = 5.0,   &  !: miminum thickness for partial steps (meters) 
     91      e3zps_rat = 0.1       !: minimum thickness ration for partial steps 
    9192 
    9293   !! z-coordinate (default option) (also used in the other cases 
    9394   !! -----------------------------  as reference z-coordinate) 
    94    REAL(wp), DIMENSION(jpk) ::   & 
    95       gdept, gdepw,    &  ! reference depth of t- and w-points (m) 
    96       e3t, e3w            ! reference vertical scale factors at T- and W-pts (m) 
     95   REAL(wp), PUBLIC, DIMENSION(jpk) ::   &  !: 
     96      gdept, gdepw,    &  !: reference depth of t- and w-points (m) 
     97      e3t, e3w            !: reference vertical scale factors at T- and W-pts (m) 
    9798 
    9899#if defined key_partial_steps 
    99100   !! Partial steps ('key_partial_steps') 
    100101   !! ----------------------------------- 
    101    LOGICAL, PARAMETER ::   lk_zps = .TRUE.   ! partial steps flag 
    102    LOGICAL, PARAMETER ::   lk_sco = .FALSE.  ! s-coordinate flag 
    103    LOGICAL, PARAMETER ::   lk_zco = .FALSE.  ! z-coordinate flag 
    104    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
    105       gdep3w,                 &  ! 
    106       gdept_ps, gdepw_ps,     &  ! depth of t- and w-points (m) 
    107       e3t_ps, e3u_ps, e3v_ps, &  ! vertical scale factors at t-, u-, w-, 
    108       e3w_ps, e3f_ps,         &  ! w-, f-, uw- and vw- points (m) 
    109       e3uw_ps, e3vw_ps 
     102   LOGICAL, PUBLIC, PARAMETER ::   lk_zps = .TRUE.   !: partial steps flag 
     103   LOGICAL, PUBLIC, PARAMETER ::   lk_sco = .FALSE.  !: s-coordinate flag 
     104   LOGICAL, PUBLIC, PARAMETER ::   lk_zco = .FALSE.  !: z-coordinate flag 
     105   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &  !: 
     106      gdep3w,                 &  !: ??? 
     107      gdept_ps, gdepw_ps,     &  !: depth of t- and w-points (m) 
     108      e3t_ps, e3u_ps, e3v_ps, &  !: vertical scale factors at t-, u-, w-, 
     109      e3w_ps, e3f_ps,         &  !: w- and f- points (m) 
     110      e3uw_ps, e3vw_ps           !: uw- and vw- points (m) 
    110111 
    111    REAL(wp), DIMENSION(jpi,jpj) ::   & 
    112       hdept, hdepw, e3tp, e3wp 
     112   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &  !: 
     113      hdept, hdepw, e3tp, e3wp   !: ??? 
    113114 
    114115#elif defined key_s_coord 
    115116   !! s-coordinate ('key_s_coord') 
    116117   !! ---------------------------- 
    117    LOGICAL, PARAMETER ::   lk_zps = .FALSE.   ! partial steps flag 
    118    LOGICAL, PARAMETER ::   lk_sco = .TRUE.    ! s-coordinate flag 
    119    LOGICAL, PARAMETER ::   lk_zco = .FALSE.   ! z-coordinate flag 
    120    REAL(wp), DIMENSION(jpi,jpj) ::   & 
    121       hbatt, hbatu,    &  ! ocean depth at the vertical of  t-, u-, v- 
    122       hbatv, hbatf        ! and f-point (m) 
     118   LOGICAL, PUBLIC, PARAMETER ::   lk_zps = .FALSE.   !: partial steps flag 
     119   LOGICAL, PUBLIC, PARAMETER ::   lk_sco = .TRUE.    !: s-coordinate flag 
     120   LOGICAL, PUBLIC, PARAMETER ::   lk_zco = .FALSE.   !: z-coordinate flag 
     121   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &   !: 
     122      hbatt, hbatu,    &  !: ocean depth at the vertical of  t-, u-, v- 
     123      hbatv, hbatf        !: and f-point (m) 
    123124 
    124    REAL(wp), DIMENSION(jpk) ::   & 
    125       gsigt, gsigw ,   &  ! model level depth coefficient at t-, w-levels 
    126       gsi3w,           &  ! model level depth coefficient at w-level 
     125   REAL(wp), PUBLIC, DIMENSION(jpk) ::   &   !: 
     126      gsigt, gsigw ,   &  !: model level depth coefficient at t-, w-levels 
     127      gsi3w,           &  !: model level depth coefficient at w-level 
    127128                          !  defined as the sum of e3w scale factors 
    128       esigt, esigw        ! vertical scale factor coef. at t-, w-levels 
     129      esigt, esigw        !: vertical scale factor coef. at t-, w-levels 
    129130 
    130131#else 
    131132   !! z-coordinate (Default option) 
    132133   !! ----------------------------- 
    133    LOGICAL, PARAMETER ::   lk_zps = .FALSE.   ! partial steps flag 
    134    LOGICAL, PARAMETER ::   lk_sco = .FALSE.   ! s-coordinate flag 
    135    LOGICAL, PARAMETER ::   lk_zco = .TRUE.    ! s-coordinate flag 
     134   LOGICAL, PUBLIC, PARAMETER ::   lk_zps = .FALSE.   !: partial steps flag 
     135   LOGICAL, PUBLIC, PARAMETER ::   lk_sco = .FALSE.   !: s-coordinate flag 
     136   LOGICAL, PUBLIC, PARAMETER ::   lk_zco = .TRUE.    !: s-coordinate flag 
    136137#endif 
    137138   !!---------------------------------------------------------------------- 
    … …  
    139140   !! ----------------- 
    140141 
    141    INTEGER , DIMENSION(jpi,jpj) ::   & 
    142       mbathy     ! number of ocean level (=0, 1, ... , jpk-1) 
     142   INTEGER , PUBLIC, DIMENSION(jpi,jpj) ::   &   !: 
     143      mbathy     !: number of ocean level (=0, 1, ... , jpk-1) 
    143144 
    144    REAL(wp), DIMENSION(jpi,jpj) ::   & 
    145       bathy  ,         &  ! ocean depth (meters) 
    146       tmask_i             ! interior domain T-point mask 
     145   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &   !: 
     146      bathy  ,         &  !: ocean depth (meters) 
     147      tmask_i             !: interior domain T-point mask 
    147148 
    148    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
    149       tmask, umask,    &  ! land/ocean mask at T-, U-, V- and F-points 
    150       vmask, fmask        ! 
     149   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &   !: 
     150      tmask, umask,    &  !: land/ocean mask at T-, U-, V- and F-points 
     151      vmask, fmask        !: 
    151152 
    152    REAL(wp), DIMENSION(jpi,jpj) ::   & 
    153       bmask               ! land/ocean mask of barotropic stream function 
     153   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &   !: 
     154      bmask               !: land/ocean mask of barotropic stream function 
    154155 
    155    REAL(wp), DIMENSION(jpiglo) ::   & 
    156       tpol, fpol          ! north fold mask (nperio= 3 or 4) 
     156   REAL(wp), PUBLIC, DIMENSION(jpiglo) ::   &   !: 
     157      tpol, fpol          !: north fold mask (nperio= 3 or 4) 
    157158 
    158159#if defined key_noslip_accurate 
    159    INTEGER, DIMENSION(4,jpk) ::   & 
    160       npcoa               ! ??? 
    161    INTEGER, DIMENSION(2*(jpi+jpj),4,jpk) ::   & 
    162       nicoa,           &  ! ??? 
    163       njcoa               ! ??? 
     160   INTEGER, PUBLIC, DIMENSION(4,jpk) ::   &   !: 
     161      npcoa               !: ??? 
     162   INTEGER, PUBLIC, DIMENSION(2*(jpi+jpj),4,jpk) ::   &   !: 
     163      nicoa,           &  !: ??? 
     164      njcoa               !: ??? 
    164165 
    165166#endif 
    … …  
    168169   !! time domain 
    169170   !!---------------------------------------------------------------------- 
    170    INTEGER ::    & 
    171       nacc   = 0 ,   &  ! = 0/1 use of the acceleration of convergence technique 
    172       neuler            ! restart euler forward option (0=Euler) 
     171   INTEGER, PUBLIC ::    & !!: * Namelist * ??? 
     172      nacc   = 0 ,       &  !: = 0/1 use of the acceleration of convergence technique 
     173      neuler                !: restart euler forward option (0=Euler) 
    173174 
    174175 
    175    REAL(wp) ::   & 
    176       rdt    = 3600._wp ,    &  ! time step for the dynamics (and tracer if nacc=0) 
    177       rdtmin = 3600._wp ,    &  ! minimum time step on tracers 
    178       rdtmax = 3600._wp ,    &  ! maximum time step on tracers 
    179       rdth   =  800._wp ,    &  ! depth variation of tracer step 
    180       atfp   = 0.1_wp   ,    &  ! asselin time filter parameter 
    181       atfp1                     ! asselin time filter coeff. (atfp1= 1-2*atfp) 
     176   REAL(wp), PUBLIC ::       & !!: * Namelist ??? * 
     177      rdt    = 3600._wp ,    &  !: time step for the dynamics (and tracer if nacc=0) 
     178      rdtmin = 3600._wp ,    &  !: minimum time step on tracers 
     179      rdtmax = 3600._wp ,    &  !: maximum time step on tracers 
     180      rdth   =  800._wp ,    &  !: depth variation of tracer step 
     181      atfp   = 0.1_wp   ,    &  !: asselin time filter parameter 
     182      atfp1                     !: asselin time filter coeff. (atfp1= 1-2*atfp) 
    182183 
    183    REAL(wp), DIMENSION(jpk) ::   & 
    184       rdttra                    ! vertical profile of tracer time step 
     184   REAL(wp), PUBLIC, DIMENSION(jpk) ::   &  !: 
     185      rdttra                    !: vertical profile of tracer time step 
    185186 
    186187   !!---------------------------------------------------------------------- 
    … …  
    188189   !!---------------------------------------------------------------------- 
    189190 
    190    INTEGER ::               & !!! namelist ??? 
    191       n_cla                    ! flag (0/1) for cross land advection to 
     191   INTEGER, PUBLIC ::       & !!: namelist ??? 
     192      n_cla                    !: flag (0/1) for cross land advection to 
    192193      !                        ! parameterize exchanges through straits 
    193194 

  • trunk/NEMO/OPA_SRC/DOM/domain.F90

    r3 r32  
    304304      ze1max = MAXVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )     
    305305      ze2max = MAXVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )     
    306 #   if defined key_mpp     
    307       CALL mpp_min( ze1min ) 
    308       CALL mpp_min( ze2min ) 
    309       CALL mpp_min( ze1max ) 
    310       CALL mpp_min( ze2max ) 
    311 #   endif 
     306 
     307      IF( lk_mpp )   CALL mpp_min( ze1min )   ! min over the global domain 
     308      IF( lk_mpp )   CALL mpp_min( ze2min ) 
     309      IF( lk_mpp )   CALL mpp_min( ze1max ) 
     310      IF( lk_mpp )   CALL mpp_min( ze2max ) 
     311 
    312312      iloc  = MINLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 ) 
    313313      iimi1 = iloc(1) + nimpp - 1 
    … …  
    322322      iima2 = iloc(1) + nimpp - 1 
    323323      ijma2 = iloc(2) + njmpp - 1 
    324 #   if defined key_mpp 
    325       CALL mpp_isl( iimi1 ) 
    326       CALL mpp_isl( ijmi1 ) 
    327       CALL mpp_isl( iimi2 ) 
    328       CALL mpp_isl( ijmi2 ) 
    329       CALL mpp_isl( iima1 ) 
    330       CALL mpp_isl( ijma1 ) 
    331       CALL mpp_isl( iima2 ) 
    332       CALL mpp_isl( ijma2 ) 
    333 #   endif 
     324 
     325      IF( lk_mpp ) THEN 
     326         CALL mpp_isl( iimi1 ) 
     327         CALL mpp_isl( ijmi1 ) 
     328         CALL mpp_isl( iimi2 ) 
     329         CALL mpp_isl( ijmi2 ) 
     330         CALL mpp_isl( iima1 ) 
     331         CALL mpp_isl( ijma1 ) 
     332         CALL mpp_isl( iima2 ) 
     333         CALL mpp_isl( ijma2 ) 
     334      ENDIF 
    334335 
    335336      IF(lwp) THEN 

  • trunk/NEMO/OPA_SRC/DOM/dommsk.F90

    r3 r32  
    1313   USE oce             ! ocean dynamics and tracers 
    1414   USE dom_oce         ! ocean space and time domain 
    15    USE in_out_manager  ! I/O manager 
    1615   USE obc_oce         ! ocean open boundary conditions 
    1716   USE in_out_manager  ! I/O manager 
    1817   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
     18   USE lib_mpp 
    1919   USE solisl          ! ??? 
     20   USE dynspg_fsc      ! 
    2021 
    2122   IMPLICIT NONE 
    … …  
    8485      !!      even IF nperio is not zero. 
    8586      !! 
    86       !!      In case of open boundaries (key_xxxobc): 
     87      !!      In case of open boundaries (lk_obc=T): 
    8788      !!        - tmask is set to 1 on the points to be computed bay the open 
    8889      !!          boundaries routines. 
    … …  
    120121      !!---------------------------------------------------------------------- 
    121122      !! *Local declarations 
    122       INTEGER  :: ji, jj, jk, ii     ! dummy loop indices 
    123       INTEGER  :: iif, iil, ijf, ijl 
     123      INTEGER  ::   ji, jj, jk, ii     ! dummy loop indices 
     124      INTEGER  ::   iif, iil, ijf, ijl 
     125      INTEGER  ::   ii0, ii1, ij0, ij1 
    124126      INTEGER, DIMENSION(jpi,jpj) ::  imsk 
    125127 
    … …  
    225227         IF( n_cla == 1 ) THEN  
    226228            !                                ! vmask = 0. on Gibraltar zonal section 
    227             vmask(mi0(138):mi1(139), mj0(101):mj1(101) , 19:jpk ) = 0.e0 
     229            ij0 = 101   ;   ij1 = 101 
     230            ii0 = 138   ;   ii1 = 139   ;   vmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 19:jpk ) = 0.e0 
    228231            !                                ! vmask = 0. on Bab el Mandeb zonal section 
    229             vmask( mi0(161):mi1(163) , mj0(87):mj1(87) , 18:jpk ) = 0.e0 
     232            ij0 =  87   ;   ij1 =  87 
     233            ii0 = 161   ;   ii1 = 163   ;   vmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 18:jpk ) = 0.e0 
    230234         ENDIF 
    231235 
    … …  
    242246       
    243247      ! Computation 
    244 #if defined key_dynspg_fsc 
    245       bmask(:,:) = tmask(:,:,1)       ! elliptic equation is written at t-point 
    246 #else  
    247       bmask(:,:) = fmask(:,:,1)       ! elliptic equation is written at f-point 
    248 #endif     
     248      IF( lk_dynspg_fsc ) THEN 
     249         bmask(:,:) = tmask(:,:,1)       ! elliptic equation is written at t-point 
     250      ELSE 
     251         bmask(:,:) = fmask(:,:,1)       ! elliptic equation is written at f-point 
     252      ENDIF 
    249253       
    250254      ! Boundary conditions 
    … …  
    262266      !   north fold :  
    263267      IF( nperio == 3 .OR. nperio == 4 ) THEN 
    264 #if defined key_dynspg_fsc 
    265          ! T-pt pivot and T-pt elliptic eq. : bmask set to 0. on row jpj and on half jpjglo-1 row 
    266          DO ji = 1, jpi 
    267             ii = ji + nimpp - 1 
    268             bmask(ji,jpj-1) = bmask(ji,jpj-1) * tpol(ii) 
    269             bmask(ji,jpj  ) = 0.e0 
    270          END DO 
    271 #else 
    272          ! T-pt pivot and F-pt elliptic eq. : bmask set to 0. on rows jpj-1 and jpj 
    273          bmask(:,jpj-1) = 0.e0 
    274          bmask(:,jpj  ) = 0.e0 
    275 #endif   
     268         IF( lk_dynspg_fsc ) THEN 
     269            ! T-pt pivot and T-pt elliptic eq. : bmask set to 0. on row jpj and on half jpjglo-1 row 
     270            DO ji = 1, jpi 
     271               ii = ji + nimpp - 1 
     272               bmask(ji,jpj-1) = bmask(ji,jpj-1) * tpol(ii) 
     273               bmask(ji,jpj  ) = 0.e0 
     274            END DO 
     275         ELSE 
     276            ! T-pt pivot and F-pt elliptic eq. : bmask set to 0. on rows jpj-1 and jpj 
     277            bmask(:,jpj-1) = 0.e0 
     278            bmask(:,jpj  ) = 0.e0 
     279         ENDIF 
    276280      ENDIF 
    277281      IF( nperio == 5 .OR. nperio == 6 ) THEN 
    278 #if defined key_dynspg_fsc 
    279          ! F-pt pivot and T-pt elliptic eq. : bmask set to 0. on row jpj 
    280          bmask(:,jpj) = 0.e0 
    281 #else 
    282          ! F-pt pivot and F-pt elliptic eq. : bmask set to 0. on row jpj and on half jpjglo-1 row 
    283          DO ji = 1, jpi 
    284             ii = ji + nimpp - 1 
    285             bmask(ji,jpj-1) = bmask(ji,jpj-1) * fpol(ii) 
    286             bmask(ji,jpj  ) = 0.e0 
    287          END DO 
    288 #endif   
     282         IF( lk_dynspg_fsc ) THEN 
     283            ! F-pt pivot and T-pt elliptic eq. : bmask set to 0. on row jpj 
     284            bmask(:,jpj) = 0.e0 
     285         ELSE 
     286            ! F-pt pivot and F-pt elliptic eq. : bmask set to 0. on row jpj and on half jpjglo-1 row 
     287            DO ji = 1, jpi 
     288               ii = ji + nimpp - 1 
     289               bmask(ji,jpj-1) = bmask(ji,jpj-1) * fpol(ii) 
     290               bmask(ji,jpj  ) = 0.e0 
     291            END DO 
     292         ENDIF 
    289293      ENDIF 
    290294 
    … …  
    292296      ! region for all elliptic solvers 
    293297 
    294 #if defined key_mpp 
    295       IF( nbondi /= -1 .AND. nbondi /= 2 ) THEN 
    296          bmask(1:jpreci,:) = 0.e0 
    297       ENDIF 
    298       IF( nbondi /= 1 .AND. nbondi /= 2 ) THEN 
    299          bmask(nlci:jpi,:) = 0.e0 
    300       ENDIF 
    301       IF( nbondj /= -1 .AND. nbondj /= 2 ) THEN 
    302          bmask(:,1:jprecj) = 0.e0 
    303       ENDIF 
    304       IF( nbondj /= 1 .AND. nbondj /= 2 ) THEN 
    305          bmask(:,nlcj:jpj) = 0.e0 
    306       ENDIF 
    307        
    308       ! north fold : bmask must be set to 0. on rows jpj-1 and jpj  
    309       IF( npolj == 3 .OR. npolj == 4 ) THEN 
    310 # if defined key_dynspg_fsc 
    311          DO ji = 1, nlci 
    312             ii = ji + nimpp - 1 
    313             bmask(ji,nlcj-1) = bmask(ji,nlcj-1) * tpol(ii) 
    314             bmask(ji,nlcj  ) = 0.e0 
    315          END DO 
    316 # else 
    317          DO ji = 1, nlci 
    318             bmask(ji,nlcj-1) = 0.e0 
    319             bmask(ji,nlcj  ) = 0.e0 
    320          END DO 
    321 # endif 
    322       ENDIF 
    323       IF( npolj == 5 .OR. npolj == 6 ) THEN 
    324 # if defined key_dynspg_fsc 
    325          DO ji = 1, nlci 
    326             ii = ji + nimpp - 1 
    327             bmask(ji,nlcj  ) = 0.e0 
    328          END DO 
    329 # else 
    330          DO ji = 1, nlci 
    331             bmask(ji,nlcj-1) = bmask(ji,nlcj-1) * fpol(ii) 
    332             bmask(ji,nlcj  ) = 0.e0 
    333          END DO 
    334 # endif 
    335       ENDIF 
    336 #endif 
     298      IF( lk_mpp ) THEN 
     299         IF( nbondi /= -1 .AND. nbondi /= 2 )   bmask(  1 :jpreci,:) = 0.e0 
     300         IF( nbondi /=  1 .AND. nbondi /= 2 )   bmask(nlci:jpi   ,:) = 0.e0 
     301         IF( nbondj /= -1 .AND. nbondj /= 2 )   bmask(:,  1 :jprecj) = 0.e0 
     302         IF( nbondj /=  1 .AND. nbondj /= 2 )   bmask(:,nlcj:jpj   ) = 0.e0 
     303       
     304         ! north fold : bmask must be set to 0. on rows jpj-1 and jpj  
     305         IF( npolj == 3 .OR. npolj == 4 ) THEN 
     306            IF( lk_dynspg_fsc ) THEN 
     307               DO ji = 1, nlci 
     308                  ii = ji + nimpp - 1 
     309                  bmask(ji,nlcj-1) = bmask(ji,nlcj-1) * tpol(ii) 
     310                  bmask(ji,nlcj  ) = 0.e0 
     311               END DO 
     312            ELSE 
     313               DO ji = 1, nlci 
     314                  bmask(ji,nlcj-1) = 0.e0 
     315                  bmask(ji,nlcj  ) = 0.e0 
     316               END DO 
     317            ENDIF 
     318         ENDIF 
     319         IF( npolj == 5 .OR. npolj == 6 ) THEN 
     320            IF( lk_dynspg_fsc ) THEN 
     321               DO ji = 1, nlci 
     322                  ii = ji + nimpp - 1 
     323                  bmask(ji,nlcj  ) = 0.e0 
     324               END DO 
     325            ELSE 
     326               DO ji = 1, nlci 
     327                  bmask(ji,nlcj-1) = bmask(ji,nlcj-1) * fpol(ii) 
     328                  bmask(ji,nlcj  ) = 0.e0 
     329               END DO 
     330            ENDIF 
     331         ENDIF 
     332      ENDIF 
    337333 
    338334 
    … …  
    354350               IF( fmask(ji,jj,jk) == 0. ) THEN 
    355351                  fmask(ji,jj,jk) = shlat * MIN( 1., MAX( zwf(ji+1,jj), zwf(ji,jj+1),   & 
    356                                                           zwf(ji-1,jj), zwf(ji,jj-1)  )  ) 
     352                     &                                    zwf(ji-1,jj), zwf(ji,jj-1)  )  ) 
    357353               ENDIF 
    358354            END DO 
    … …  
    386382         IF( n_cla == 0 ) THEN 
    387383            !                                ! Gibraltar strait and Gulf of Cadiz 
    388             fmask( mi0(137):mi1(140) , mj0(101):mj1(102) , 1:jpk ) = 14.7e0 
     384            ij0 = 101   ;   ij1 = 102 
     385            ii0 = 137   ;   ii1 = 140   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 14.7e0 
    389386            !                                ! Bab el Mandeb strait 
    390             fmask( mi0(162):mi1(163) , mj0( 87):mj1( 88) , 1:jpk ) = 20.e0 
     387            ij0 =  87   ;   ij1 =  88 
     388            ii0 = 162   ;   ii1 = 163   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 20.0e0 
    391389            !                                ! Sound  strait 
    392             fmask( mi0(147):mi1(148) , mj0(116):mj1(117) , 1:jpk ) = 10.e0 
     390            ij0 = 116   ;   ij1 = 117 
     391            ii0 = 147   ;   ii1 = 148   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 10.0e0 
    393392         ELSE 
    394393            !                                ! Gibraltar strait and Gulf of Cadiz 
    395             fmask( mi0(137):mi1(139) , mj0(102):mj1(102) , 1:jpk ) =  0.e0 
    396             fmask( mi0(137):mi1(139) , mj0(100):mj1(100) , 1:jpk ) =  0.e0 
    397             fmask( mi0(139):mi1(139) , mj0(101):mj1(101) , 1:jpk ) =  0.e0 
     394            ij0 = 102   ;   ij1 = 102 
     395            ii0 = 137   ;   ii1 = 139   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  0.0e0 
     396            ij0 = 101   ;   ij1 = 101 
     397            ii0 = 139   ;   ii1 = 139   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  0.0e0 
     398            ij0 = 100   ;   ij1 = 100 
     399            ii0 = 137   ;   ii1 = 139   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  0.0e0 
    398400            !                                ! Sound  strait 
    399             fmask( mi0(147):mi1(148) , mj0(116):mj1(117) , 1:jpk ) = 10.e0 
     401            ij0 = 116   ;   ij1 = 117 
     402            ii0 = 147   ;   ii1 = 148   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 10.0e0 
    400403         ENDIF 
    401404         ! 
    … …  
    497500      IF(lwp)WRITE(numout,*) 'dom_msk_nsa : noslip accurate boundary condition' 
    498501      IF(lwp)WRITE(numout,*) '~~~~~~~~~~~   using Schchepetkin and O Brian scheme' 
    499 # if defined key_mpp 
    500       IF(lwp)WRITE(numout,cform_err) 
    501       IF(lwp)WRITE(numout,*) ' mpp version is not yet implemented' 
    502       nstop = nstop + 1 
    503 # endif 
     502      IF( lk_mpp ) THEN 
     503         IF(lwp)WRITE(numout,cform_err) 
     504         IF(lwp)WRITE(numout,*) ' mpp version is not yet implemented' 
     505         nstop = nstop + 1 
     506      ENDIF 
    504507 
    505508      ! mask for second order calculation of vorticity 
    … …  
    532535            DO ji = 1, jpim1 
    533536               zaa = tmask(ji  ,jj,jk) + tmask(ji  ,jj+1,jk)   & 
    534                    + tmask(ji+1,jj,jk) + tmask(ji+1,jj+1,jk) 
     537                  &+ tmask(ji+1,jj,jk) + tmask(ji+1,jj+1,jk) 
    535538               IF( ABS(zaa-3.) <= 0.1 )   fmask(ji,jj,jk) = 1. 
    536539            END DO 
    … …  
    598601            WRITE(numout,*) 
    599602            WRITE(numout,*) ' level jk = ',jk 
    600             WRITE(numout,*) ' straight coast index arraies are',   & 
    601                ' too small.:' 
    602             WRITE(numout,*) ' npe, npw, nps, npn = ',   & 
    603                 npcoa(1,jk), npcoa(2,jk),   & 
    604                 npcoa(3,jk), npcoa(4,jk) 
     603            WRITE(numout,*) ' straight coast index arraies are too small.:' 
     604            WRITE(numout,*) ' npe, npw, nps, npn = ', npcoa(1,jk), npcoa(2,jk),   & 
     605                &                                     npcoa(3,jk), npcoa(4,jk) 
    605606            WRITE(numout,*) ' 2*(jpi+jpj) = ',itest,'. we stop.' 
    606             STOP 
     607            STOP   !!bug nstop to be used 
    607608        ENDIF 
    608609      END DO 
    … …  
    654655         DO jl = 1, ierror 
    655656            IF(lwp) WRITE(numout,*) 'Level:',icoord(jl,3),   & 
    656                '  Point(',icoord(jl,1),',',icoord(jl,2),')' 
    657          END DO 
    658          IF(lwp) WRITE(numout,*) 'We stop...' 
     657               &                  '  Point(',icoord(jl,1),',',icoord(jl,2),')' 
     658         END DO 
     659         IF(lwp) WRITE(numout,*) 'We stop...'   !!cr print format to be used 
    659660         nstop = nstop + 1 
    660661      ENDIF 

  • trunk/NEMO/OPA_SRC/DYN/dynhpg.F90

    r3 r32  
    3131   !!   'key_autotasking' :                             j-k-i loop (j-slab) 
    3232   !!---------------------------------------------------------------------- 
    33    LOGICAL, PUBLIC ::   l_dyn_hpg_tsk = .TRUE.    ! ??? 
    34    LOGICAL, PUBLIC ::   l_dyn_hpg     = .FALSE.   ! ??? 
     33   LOGICAL, PUBLIC, PARAMETER ::   lk_dynhpg_tsk = .TRUE.    !: autotasked hpg flag 
     34   LOGICAL, PUBLIC, PARAMETER ::   lk_dynhpg     = .FALSE.   !: vector hpg flag 
    3535#else 
    3636   !!---------------------------------------------------------------------- 
    3737   !!   default case :                             k-j-i loop (vector opt.) 
    3838   !!----------------------------------------------------------------------    
    39    LOGICAL, PUBLIC ::   l_dyn_hpg_tsk = .FALSE.   ! ??? 
    40    LOGICAL, PUBLIC ::   l_dyn_hpg     = .TRUE.    ! ??? 
     39   LOGICAL, PUBLIC, PARAMETER ::   lk_dynhpg_tsk = .FALSE.   !: autotasked hpg flag 
     40   LOGICAL, PUBLIC, PARAMETER ::   lk_dynhpg     = .TRUE.    !: vector hpg flag 
    4141#endif 
    4242 
    … …  
    6767      !!      level. s-coordinates ('key_s_coord'): a corrective term is added 
    6868      !!      to the horizontal pressure gradient : 
    69       !!         zhpi = g .....  + 1/e1u mi(rhd) di[ g dep3w ] 
    70       !!         zhpj = g .....  + 1/e2v mj(rhd) dj[ g dep3w ] 
     69      !!         zhpi = grav .....  + 1/e1u mi(rhd) di[ grav dep3w ] 
     70      !!         zhpj = grav .....  + 1/e2v mj(rhd) dj[ grav dep3w ] 
    7171      !!      add it to the general momentum trend (ua,va). 
    7272      !!         ua = ua - 1/e1u * zhpi 
    … …  
    104104      ! 0. Local constant initialization 
    105105      ! -------------------------------- 
    106       zcoef0 = -g * 0.5 
     106      zcoef0 = - grav * 0.5 
    107107      zuap   = 0.e0 
    108108      zvap   = 0.e0 
    … …  
    187187      !!      jk is computed by taking the vertical integral of the in-situ  
    188188      !!      density gradient along the model level from the suface to that 
    189       !!      level:   zhpi = g ..... 
    190       !!               zhpj = g ..... 
     189      !!      level:   zhpi = grav ..... 
     190      !!               zhpj = grav ..... 
    191191      !!      add it to the general momentum trend (ua,va). 
    192192      !!            ua = ua - 1/e1u * zhpi 
    … …  
    223223      ! 0. Local constant initialization 
    224224      ! -------------------------------- 
    225       zcoef0 = -g * 0.5 
     225      zcoef0 = - grav * 0.5 
    226226      zuap   = 0.e0 
    227227      zvap   = 0.e0 
    … …  
    342342      !!      jk is computed by taking the vertical integral of the in-situ 
    343343      !!      density gradient along the model level from the suface to that 
    344       !!      level:    zhpi = g ..... 
    345       !!                zhpj = g ..... 
     344      !!      level:    zhpi = grav ..... 
     345      !!                zhpj = grav ..... 
    346346      !!      add it to the general momentum trend (ua,va). 
    347347      !!            ua = ua - 1/e1u * zhpi 
    … …  
    379379      ! 0. Local constant initialization 
    380380      ! -------------------------------- 
    381       zcoef0 = -g * 0.5 
     381      zcoef0 = - grav * 0.5 
    382382      zuap   = 0.e0 
    383383      zvap   = 0.e0 

  • trunk/NEMO/OPA_SRC/DYN/dynhpg_atsk.F90

    r3 r32  
    5656      !!      level. s-coordinate case ('key_s_coord'): a corrective term is 
    5757      !!      added to the horizontal pressure gradient : 
    58       !!         zhpi = g .....   + 1/e1u mi(rhd) di[ g dep3w ] 
    59       !!         zhpj = g .....   + 1/e2v mj(rhd) dj[ g dep3w ] 
     58      !!         zhpi = grav .....   + 1/e1u mi(rhd) di[ grav dep3w ] 
     59      !!         zhpj = grav .....   + 1/e2v mj(rhd) dj[ grav dep3w ] 
    6060      !!      add it to the general momentum trend (ua,va). 
    6161      !!         ua = ua - 1/e1u * zhpi 
    … …  
    9292      ! 0. Local constant initialization 
    9393      ! -------------------------------- 
    94       zcoef0 = -g * 0.5 
     94      zcoef0 = - grav * 0.5 
    9595 
    9696      !                                                ! =============== 
    … …  
    174174      !!      jk is computed by taking the vertical integral of the in-situ 
    175175      !!      density gradient along the model level from the suface to that  
    176       !!      level:    zhpi = g ..... 
    177       !!                zhpj = g ..... 
     176      !!      level:    zhpi = grav ..... 
     177      !!                zhpj = grav ..... 
    178178      !!      add it to the general momentum trend (ua,va). 
    179179      !!            ua = ua - 1/e1u * zhpi 
    … …  
    210210      ! 0. Local constant initialization 
    211211      ! -------------------------------- 
    212       zcoef0 = -g * 0.5 
     212      zcoef0 = - grav * 0.5 
    213213      zuap   = 0.e0 
    214214      zvap   = 0.e0 
    … …  
    313313      !!      jk is computed by taking the vertical integral of the in-situ   
    314314      !!      density gradient along the model level from the suface to that 
    315       !!      level:    zhpi = g ..... 
    316       !!                zhpj = g ..... 
     315      !!      level:    zhpi = grav ..... 
     316      !!                zhpj = grav ..... 
    317317      !!      add it to the general momentum trend (ua,va). 
    318318      !!            ua = ua - 1/e1u * zhpi 
    … …  
    351351      ! 0. Local constant initialization 
    352352      ! -------------------------------- 
    353       zcoef0 = -g * 0.5 
     353      zcoef0 = - grav * 0.5 
    354354 
    355355      !                                                ! =============== 

  • trunk/NEMO/OPA_SRC/DYN/dynldf_bilapg.F90

    r3 r32  
    465465CONTAINS 
    466466   SUBROUTINE dyn_ldf_bilapg( kt )               ! Dummy routine 
    467       WRITE(*,*) kt 
     467      WRITE(*,*) 'dyn_ldf_bilapg: You should not have seen this print! error?', kt 
    468468   END SUBROUTINE dyn_ldf_bilapg 
    469469#endif 

  • trunk/NEMO/OPA_SRC/DYN/dynldf_iso.F90

    r3 r32  
    251251CONTAINS 
    252252   SUBROUTINE dyn_ldf_iso( kt )               ! Empty routine 
    253       WRITE(*,*) kt 
     253      WRITE(*,*) 'dyn_ldf_iso: You should not have seen this print! error?', kt 
    254254   END SUBROUTINE dyn_ldf_iso 
    255255#endif 

  • trunk/NEMO/OPA_SRC/DYN/dynnxt.F90

    r3 r32  
    3535      !!      After velocity is compute using a leap-frog scheme environment: 
    3636      !!         (ua,va) = (ub,vb) + 2 rdt (ua,va) 
    37       !!      Note that if "key_dynspg_fsc" defined, the time stepping  
    38       !!      has already been performed in dynspg.F routine 
     37      !!      Note that if lk_dynspg_fsc=T, the time stepping has already been 
     38      !!      performed in dynspg module 
    3939      !!      Time filter applied on now horizontal velocity to avoid the 
    4040      !!      divergence of two consecutive time-steps and swap of dynamics 

  • trunk/NEMO/OPA_SRC/DYN/dynvor.F90

    r3 r32  
    2727 
    2828   !! * Shared module variables 
    29    LOGICAL, PUBLIC ::   ln_dynvor_ene = .FALSE.   ! energy conserving scheme 
    30    LOGICAL, PUBLIC ::   ln_dynvor_ens = .TRUE.    ! enstrophy conserving scheme 
    31    LOGICAL, PUBLIC ::   ln_dynvor_mix = .FALSE.   ! mixed scheme 
     29   LOGICAL, PUBLIC ::   ln_dynvor_ene = .FALSE.   !: energy conserving scheme 
     30   LOGICAL, PUBLIC ::   ln_dynvor_ens = .TRUE.    !: enstrophy conserving scheme 
     31   LOGICAL, PUBLIC ::   ln_dynvor_mix = .FALSE.   !: mixed scheme 
    3232 
    3333   !! * Substitutions 

  • trunk/NEMO/OPA_SRC/DYN/dynzdf_iso.F90

    r3 r32  
    387387CONTAINS 
    388388   SUBROUTINE dyn_zdf_iso( kt )                        ! Dummy routine 
    389       WRITE(*,*) kt 
     389      WRITE(*,*) 'dyn_zdf_iso: You should not have seen this print! error?', kt 
    390390   END SUBROUTINE dyn_zdf_iso 
    391391#endif 

  • trunk/NEMO/OPA_SRC/LDF/ldfdyn_c2d.h90

    r3 r32  
    1717      !! 
    1818      !! ** Method : 
    19       !!                   **** W A R N I N G **** 
    20       !!                     ORCA OCEAN VERSION 
    21       !!    This method is relevant ONLY for the grid build by the method 
    22       !!               given in the 'Reference' section. 
    23       !!                   **** W A R N I N G **** 
    24       !! 
    2519      !!      2D eddy viscosity coefficients ( longitude, latitude ) 
    2620      !! 
    … …  
    5549 
    5650         zdx_max = MAXVAL( e1t(:,:) ) 
    57 #if defined key_mpp 
    58          CALL mpp_max( zdx_max ) 
    59 #endif 
     51         IF( lk_mpp )   CALL mpp_max( zdx_max )   ! max over the global domain 
     52 
    6053         IF(lwp) WRITE(numout,*) '              laplacian operator: ahm proportional to e1' 
    6154         IF(lwp) WRITE(numout,*) '              Caution, here we assume your mesh is isotropic ...' 
    … …  
    9689 
    9790         zdx_max = MAXVAL( e1u(:,:) ) 
    98 #if defined key_mpp 
    99          CALL mpp_max( zdx_max ) 
    100 #endif 
     91         IF( lk_mpp )   CALL mpp_max( zdx_max )   ! max over the global domain 
     92 
    10193         IF(lwp) WRITE(numout,*) '              bi-laplacian operator: ahm proportional to e1**3 ' 
    10294         IF(lwp) WRITE(numout,*) '              Caution, here we assume your mesh is isotropic ...' 
    … …  
    141133 
    142134      !! * Arguments 
    143       LOGICAL, INTENT (in) :: ld_print   ! If true, output arrays on numout 
     135      LOGICAL, INTENT (in) ::   ld_print   ! If true, output arrays on numout 
    144136 
    145137      !! * Local variables 
    146       INTEGER :: ji, jj      ! dummy loop indices 
    147       INTEGER :: inumcf, iost, iim, ijm 
    148       INTEGER :: jn 
    149       INTEGER :: ifreq, il1, il2, ij, ii, inorth, isouth 
    150       INTEGER :: ipi, ipj, iumout, iwork, icompt, ibtest, ikmax 
    151       INTEGER :: ijpt0, ijpt1, iipt0, iipt1 
    152       INTEGER ,DIMENSION(jpidta,jpidta) :: idata 
    153       INTEGER ,DIMENSION(jpi   ,jpj   ) :: icof 
     138      INTEGER ::   ji, jj, jn      ! dummy loop indices 
     139      INTEGER ::   inum = 11       ! temporary logical unit 
     140      INTEGER ::   iost, iim, ijm 
     141      INTEGER ::   ifreq, il1, il2, ij, ii 
     142      INTEGER, DIMENSION(jpidta,jpidta) ::   idata 
     143      INTEGER, DIMENSION(jpi   ,jpj   ) ::   icof 
    154144 
    155145      REAL(wp) ::   zahmeq, zcoft, zcoff, zmsk 
    … …  
    173163      ! ===================== equatorial strip (20N-20S) defined at t-points 
    174164 
    175       inumcf = 15 
    176       OPEN( UNIT=inumcf,FILE='ahmcoef',STATUS='OLD',   & 
    177             FORM='FORMATTED', ACCESS='SEQUENTIAL', ERR=111 ,   & 
    178             IOSTAT= iost)  
     165      OPEN( UNIT=inum, FILE='ahmcoef', STATUS='OLD',   & 
     166         &  FORM='FORMATTED', ACCESS='SEQUENTIAL', ERR=111 ,   & 
     167         &  IOSTAT= iost )  
    179168      IF( iost == 0 ) THEN 
    180169         IF(lwp) WRITE(numout,*) '     file   : ahmcoef open ok' 
    181          IF(lwp) WRITE(numout,*) '     unit   = ', inumcf 
     170         IF(lwp) WRITE(numout,*) '     unit   = ', inum 
    182171         IF(lwp) WRITE(numout,*) '     status = OLD' 
    183172         IF(lwp) WRITE(numout,*) '     form   = FORMATTED' 
    … …  
    195184      ENDIF 
    196185 
    197       REWIND inumcf 
    198       READ(inumcf,9101) clexp, iim, ijm 
    199       READ(inumcf,'(/)') 
     186      REWIND inum 
     187      READ(inum,9101) clexp, iim, ijm 
     188      READ(inum,'(/)') 
    200189      ifreq = 40 
    201190      il1 = 1 
    202191      DO jn = 1, jpidta/ifreq+1 
    203          READ(inumcf,'(/)') 
     192         READ(inum,'(/)') 
    204193         il2 = MIN( jpidta, il1+ifreq-1 ) 
    205          READ(inumcf,9201) ( ii, ji = il1, il2, 5 ) 
    206          READ(inumcf,'(/)') 
     194         READ(inum,9201) ( ii, ji = il1, il2, 5 ) 
     195         READ(inum,'(/)') 
    207196         DO jj = jpjdta, 1, -1 
    208             READ(inumcf,9202) ij, ( idata(ji,jj), ji = il1, il2 ) 
     197            READ(inum,9202) ij, ( idata(ji,jj), ji = il1, il2 ) 
    209198         END DO 
    210199         il1 = il1 + ifreq 

  • trunk/NEMO/OPA_SRC/LDF/ldfdyn_c3d.h90

    r3 r32  
    4949 
    5050         zdx_max = MAXVAL( e1t(:,:) ) 
    51 #if defined key_mpp 
    52          CALL mpp_max( zdx_max ) 
    53 #endif 
     51         IF( lk_mpp )   CALL mpp_max( zdx_max )   ! max over the global domain 
     52 
    5453         IF(lwp) WRITE(numout,*) '              laplacian operator: ahm proportional to e1' 
    5554         IF(lwp) WRITE(numout,*) '              Caution, here we assume your mesh is isotropic ...' 
    … …  
    105104 
    106105         zdx_max = MAXVAL( e1u(:,:) ) 
    107 #if defined key_mpp 
    108          CALL mpp_max( zdx_max ) 
    109 #endif 
     106         IF( lk_mpp )   CALL mpp_max( zdx_max )   ! max over the global domain 
     107 
    110108         IF(lwp) WRITE(numout,*) '              bi-laplacian operator: ahm proportional to e1**3 ' 
    111109         IF(lwp) WRITE(numout,*) '              Caution, here we assume your mesh is isotropic ...' 
    … …  
    133131         ELSE                            ! partial steps or s-ccordinate 
    134132            zc = MAXVAL( fsdept(:,:,jpkm1) ) 
    135 #if defined key_mpp 
    136             CALL mpp_max( zc ) 
    137 #endif 
     133            IF( lk_mpp )   CALL mpp_max( zc )   ! max over the global domain 
     134 
    138135            zc = 1. / (  1. - EXP( ( zc - zh ) / zh )  ) 
    139136            DO jk = 2, jpkm1 
    … …  
    188185 
    189186      !! * local variables 
    190       INTEGER ::inumcf, iost, iim, ijm 
    191       INTEGER ::ji,jj,jk, jn 
    192       INTEGER ::ifreq, il1, il2, ij, ii 
    193       INTEGER ,DIMENSION(jpidta, jpjdta) :: idata 
    194       INTEGER ,DIMENSION(jpi   , jpj   ) :: icof 
     187      INTEGER ::   ji, jj, jk, jn      ! dummy loop indices 
     188      INTEGER ::   inum = 11           ! temporary logical unit 
     189      INTEGER ::   iost, iim, ijm 
     190      INTEGER ::   ifreq, il1, il2, ij, ii 
     191      INTEGER, DIMENSION(jpidta, jpjdta) ::   idata 
     192      INTEGER, DIMENSION(jpi   , jpj   ) ::   icof 
    195193 
    196194      REAL(wp) ::   zahmeq, zcoff, zcoft, zmsk 
    197       REAL(wp) ::   zcoef(jpk) 
     195      REAL(wp), DIMENSION(jpk) ::   zcoef 
    198196 
    199197      CHARACTER (len=15) ::   clexp 
    … …  
    211209      ! ===================== equatorial strip (20N-20S) defined at t-points 
    212210 
    213       inumcf = 15 
    214       OPEN( UNIT=inumcf,FILE='ahmcoef',STATUS='OLD',   & 
    215             FORM='FORMATTED', ACCESS='SEQUENTIAL', ERR=111 ,   & 
    216             IOSTAT= iost) 
     211      OPEN( UNIT=inum, FILE='ahmcoef', STATUS='OLD',   & 
     212         &  FORM='FORMATTED', ACCESS='SEQUENTIAL', ERR=111 ,   & 
     213         &  IOSTAT= iost) 
    217214      IF( iost == 0 ) THEN 
    218215         IF(lwp) THEN 
    219216            WRITE(numout,*) '     file   : ahmcoef open ok' 
    220             WRITE(numout,*) '     unit   = ', inumcf 
     217            WRITE(numout,*) '     unit   = ', inum 
    221218            WRITE(numout,*) '     status = OLD' 
    222219            WRITE(numout,*) '     form   = FORMATTED' 
    … …  
    235232      ENDIF 
    236233 
    237       REWIND inumcf 
    238       READ(inumcf,9101) clexp, iim, ijm 
    239       READ(inumcf,'(/)') 
     234      REWIND inum 
     235      READ(inum,9101) clexp, iim, ijm 
     236      READ(inum,'(/)') 
    240237      ifreq = 40 
    241238      il1 = 1 
    242239      DO jn = 1, jpidta/ifreq+1 
    243          READ(inumcf,'(/)') 
     240         READ(inum,'(/)') 
    244241         il2 = MIN( jpidta, il1+ifreq-1 ) 
    245          READ(inumcf,9201) ( ii, ji = il1, il2, 5 ) 
    246          READ(inumcf,'(/)') 
     242         READ(inum,9201) ( ii, ji = il1, il2, 5 ) 
     243         READ(inum,'(/)') 
    247244         DO jj = jpjdta, 1, -1 
    248             READ(inumcf,9202) ij, ( idata(ji,jj), ji = il1, il2 ) 
     245            READ(inum,9202) ij, ( idata(ji,jj), ji = il1, il2 ) 
    249246         END DO 
    250247         il1 = il1 + ifreq 

  • trunk/NEMO/OPA_SRC/LDF/ldfeiv_substitute.h90

    r3 r32  
    1 #if defined key_traldf_eiv 
     1#if defined key_traldf_eiv   ||   defined key_esopa 
    22   !!---------------------------------------------------------------------- 
    33   !!                   ***  ldfeiv_substitute.h90  *** 

  • trunk/NEMO/OPA_SRC/LDF/ldfslp.F90

    r3 r32  
    2929 
    3030   !! * Share module variables 
    31    LOGICAL , PUBLIC, PARAMETER ::   lk_ldfslp = .TRUE.     ! slopes flag 
    32    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   & 
    33       uslp, wslpi,         &  ! i_slope at U- and W-points 
    34       vslp, wslpj             ! j-slope at V- and W-points 
     31   LOGICAL , PUBLIC, PARAMETER ::   lk_ldfslp = .TRUE.     !: slopes flag 
     32   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &  !: 
     33      uslp, wslpi,         &  !: i_slope at U- and W-points 
     34      vslp, wslpj             !: j-slope at V- and W-points 
    3535    
    3636   !! * Module variables 
    … …  
    9595 
    9696      !! * Local declarations 
    97       INTEGER  ::   ji, jj, jk      ! dummy loop indices 
     97      INTEGER  ::   ji, jj, jk              ! dummy loop indices 
     98      INTEGER  ::   ii0, ii1, ij0, ij1      ! temporary integer 
    9899#if defined key_partial_steps 
    99100      INTEGER  ::   iku, ikv  ! temporary integers 
    … …  
    120121       
    121122      zeps  =  1.e-20 
    122       zmg   = -1.0 / g 
    123       zm05g = -0.5 / g 
     123      zmg   = -1.0 / grav 
     124      zm05g = -0.5 / grav 
    124125 
    125126      zww(:,:,:) = 0.e0 
    … …  
    177178          
    178179         ! Local vertical density gradient evaluated from N^2 
    179          ! zwy = d/dz(prd)= - ( prd ) / g * mk(pn2) -- at t point 
     180         ! zwy = d/dz(prd)= - ( prd ) / grav * mk(pn2) -- at t point 
    180181 
    181182         DO jj = 1, jpj 
    … …  
    323324          
    324325         ! Local vertical density gradient evaluated from N^2 
    325          !     zwy = d/dz(prd)= - mk ( prd ) / g * pn2 -- at w point 
     326         !     zwy = d/dz(prd)= - mk ( prd ) / grav * pn2 -- at w point 
    326327         DO jj = 1, jpj 
    327328            DO ji = 1, jpi 
    … …  
    450451            ! 
    451452            !                                             ! Gibraltar Strait 
    452             uslp ( mi0(69):mi1(71) , mj0(50):mj1(53) , jk ) = 0.0e0 
    453             vslp ( mi0(68):mi1(71) , mj0(51):mj1(53) , jk ) = 0.0e0 
    454             wslpi( mi0(69):mi1(71) , mj0(51):mj1(53) , jk ) = 0.0e0 
    455             wslpj( mi0(69):mi1(71) , mj0(51):mj1(53) , jk ) = 0.0e0 
     453            ij0 =  50   ;   ij1 =  53 
     454            ii0 =  69   ;   ii1 =  71   ;   uslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , jk ) = 0.e0 
     455            ij0 =  51   ;   ij1 =  53 
     456            ii0 =  68   ;   ii1 =  71   ;   vslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , jk ) = 0.e0 
     457            ii0 =  69   ;   ii1 =  71   ;   wslpi( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , jk ) = 0.e0 
     458            ii0 =  69   ;   ii1 =  71   ;   wslpj( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , jk ) = 0.e0 
    456459 
    457460            !                                             ! Mediterrannean Sea 
    458             uslp ( mi0(71):mi1(90) , mj0(49):mj1(56) , jk ) = 0.0e0 
    459             vslp ( mi0(70):mi1(90) , mj0(50):mj1(56) , jk ) = 0.0e0 
    460             wslpi( mi0(71):mi1(90) , mj0(50):mj1(56) , jk ) = 0.0e0 
    461             wslpj( mi0(71):mi1(90) , mj0(50):mj1(56) , jk ) = 0.0e0 
     461            ij0 =  49   ;   ij1 =  56 
     462            ii0 =  71   ;   ii1 =  90   ;   uslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , jk ) = 0.e0 
     463            ij0 =  50   ;   ij1 =  56 
     464            ii0 =  70   ;   ii1 =  90   ;   vslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , jk ) = 0.e0 
     465            ii0 =  71   ;   ii1 =  90   ;   wslpi( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , jk ) = 0.e0 
     466            ii0 =  71   ;   ii1 =  90   ;   wslpj( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , jk ) = 0.e0 
    462467         ENDIF 
    463468         !                                             ! =============== 
    … …  
    527532 
    528533      zeps  =  1.e-20 
    529       zmg   = -1.0 / g 
    530       zm05g = -0.5 / g 
     534      zmg   = -1.0 / grav 
     535      zm05g = -0.5 / grav 
    531536 
    532537 
    … …  
    567572 
    568573      ! Local vertical density gradient evaluated from N^2 
    569       ! zwy = d/dz(prd)= - ( prd ) / g * mk(pn2) -- at t point 
     574      ! zwy = d/dz(prd)= - ( prd ) / grav * mk(pn2) -- at t point 
    570575 
    571576      !----------------------------------------------------------------------- 
    … …  
    619624 
    620625      ! Local vertical density gradient evaluated from N^2 
    621       !     zwy = d/dz(prd)= - ( prd ) / g * mk(pn2) -- at t point 
     626      !     zwy = d/dz(prd)= - ( prd ) / grav * mk(pn2) -- at t point 
    622627      zwy ( :, jpj) = 0.0e0 
    623628      zwy ( jpi, :) = 0.0e0 
    … …  
    673678 
    674679      ! Local vertical density gradient evaluated from N^2 
    675       ! zwy = d/dz(prd)= - mk ( prd ) / g * pn2 -- at w point 
     680      ! zwy = d/dz(prd)= - mk ( prd ) / grav * pn2 -- at w point 
    676681# if defined key_vectopt_loop   &&   ! defined key_autotasking 
    677682      jj = 1 
    … …  
    809814   !!   Dummy module :                 NO Rotation of lateral mixing tensor 
    810815   !!------------------------------------------------------------------------ 
    811    LOGICAL, PUBLIC, PARAMETER ::   lk_ldfslp = .FALSE.    ! slopes flag 
     816   LOGICAL, PUBLIC, PARAMETER ::   lk_ldfslp = .FALSE.    !: slopes flag 
    812817CONTAINS 
    813818   SUBROUTINE ldf_slp( kt, prd, pn2 )        ! Dummy routine 
    814819      INTEGER, INTENT(in) :: kt  
    815820      REAL,DIMENSION(:,:,:), INTENT(in) :: prd, pn2 
    816       WRITE(*,*) kt, prd, pn2 
     821      WRITE(*,*) 'ldf_slp: You should not have seen this print! error?', kt, prd(1,1,1), pn2(1,1,1) 
    817822   END SUBROUTINE ldf_slp 
    818823#endif 

  • trunk/NEMO/OPA_SRC/LDF/ldftra_oce.F90

    r3 r32  
    2222   !!---------------------------------------------------------------------- 
    2323 
    24    LOGICAL , PUBLIC ::              & !!! ** lateral mixing namelist (nam_traldf) ** 
    25       ln_traldf_lap   = .TRUE.  ,   &  ! laplacian operator 
    26       ln_traldf_bilap = .FALSE. ,   &  ! bilaplacian operator 
    27       ln_traldf_level = .FALSE. ,   &  ! iso-level direction 
    28       ln_traldf_hor   = .FALSE. ,   &  ! horizontal (geopotential) direction 
    29       ln_traldf_iso   = .TRUE.         ! iso-neutral direction 
     24   LOGICAL , PUBLIC ::              & !!: ** lateral mixing namelist (nam_traldf) ** 
     25      ln_traldf_lap   = .TRUE.  ,   &  !: laplacian operator 
     26      ln_traldf_bilap = .FALSE. ,   &  !: bilaplacian operator 
     27      ln_traldf_level = .FALSE. ,   &  !: iso-level direction 
     28      ln_traldf_hor   = .FALSE. ,   &  !: horizontal (geopotential) direction 
     29      ln_traldf_iso   = .TRUE.         !: iso-neutral direction 
    3030 
    31    REAL(wp), PUBLIC ::              & !!! ** lateral mixing namelist (namldf) ** 
    32       aht0  = 2000._wp     ,        &  ! lateral eddy diffusivity (m2/s) 
    33       ahtb0 =    0._wp     ,        &  ! lateral background eddy diffusivity (m2/s) 
    34       aeiv0 = 2000._wp                 ! eddy induced velocity coefficient (m2/s) 
     31   REAL(wp), PUBLIC ::              & !!: ** lateral mixing namelist (namldf) ** 
     32      aht0  = 2000._wp     ,        &  !: lateral eddy diffusivity (m2/s) 
     33      ahtb0 =    0._wp     ,        &  !: lateral background eddy diffusivity (m2/s) 
     34      aeiv0 = 2000._wp                 !: eddy induced velocity coefficient (m2/s) 
    3535 
    36    LOGICAL , PUBLIC ::              &  ! flag of the lateral diff. scheme used  
    37       l_traldf_lap         ,        &  ! iso-level laplacian operator 
    38       l_traldf_bilap       ,        &  ! iso-level bilaplacian operator 
    39       l_traldf_bilapg      ,        &  ! geopotential bilap. (s-coord) 
    40       l_traldf_iso         ,        &  ! iso-neutral laplacian or horizontal lapacian (s-coord) 
    41       l_trazdf_iso         ,        &  ! idem for the vertical component 
    42       l_trazdf_iso_vo      ,        &  ! idem with vectopt_memory 
    43       l_traldf_iso_zps                 ! iso-neutral laplacian (partial steps) 
     36   LOGICAL , PUBLIC ::              &  !: flag of the lateral diff. scheme used  
     37      l_traldf_lap         ,        &  !: iso-level laplacian operator 
     38      l_traldf_bilap       ,        &  !: iso-level bilaplacian operator 
     39      l_traldf_bilapg      ,        &  !: geopotential bilap. (s-coord) 
     40      l_traldf_iso         ,        &  !: iso-neutral laplacian or horizontal lapacian (s-coord) 
     41      l_trazdf_iso         ,        &  !: idem for the vertical component 
     42      l_trazdf_iso_vo      ,        &  !: idem with vectopt_memory 
     43      l_traldf_iso_zps                 !: iso-neutral laplacian (partial steps) 
    4444 
    4545#if defined key_traldf_c3d 
    46    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &  ! ** 3D coefficients ** 
     46   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &  !: ** 3D coefficients ** 
    4747#elif defined key_traldf_c2d 
    48    REAL(wp), PUBLIC, DIMENSION(jpi,jpj)     ::   &  ! ** 2D coefficients ** 
     48   REAL(wp), PUBLIC, DIMENSION(jpi,jpj)     ::   &  !: ** 2D coefficients ** 
    4949#elif defined key_traldf_c1d 
    50    REAL(wp), PUBLIC, DIMENSION(jpk)         ::   &  ! ** 1D coefficients ** 
     50   REAL(wp), PUBLIC, DIMENSION(jpk)         ::   &  !: ** 1D coefficients ** 
    5151#else 
    52    REAL(wp), PUBLIC                         ::   &  ! ** 0D coefficients ** 
     52   REAL(wp), PUBLIC                         ::   &  !: ** 0D coefficients ** 
    5353#endif 
    54       ahtt, ahtu, ahtv, ahtw                ! T-, U-, V-, W-points coefficients 
     54      ahtt, ahtu, ahtv, ahtw                !: T-, U-, V-, W-points coefficients 
    5555 
    5656 
    … …  
    5959   !!   'key_traldf_eiv'                              eddy induced velocity 
    6060   !!---------------------------------------------------------------------- 
    61    LOGICAL, PUBLIC, PARAMETER ::   lk_traldf_eiv   = .TRUE.   ! eddy induced velocity flag 
     61   LOGICAL, PUBLIC, PARAMETER ::   lk_traldf_eiv   = .TRUE.   !: eddy induced velocity flag 
    6262       
    6363# if defined key_traldf_c3d 
    64    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &  ! ** 3D coefficients ** 
     64   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &  !: ** 3D coefficients ** 
    6565# elif defined key_traldf_c2d 
    66    REAL(wp), PUBLIC, DIMENSION(jpi,jpj)     ::   &  ! ** 2D coefficients ** 
     66   REAL(wp), PUBLIC, DIMENSION(jpi,jpj)     ::   &  !: ** 2D coefficients ** 
    6767# elif defined key_traldf_c1d 
    68    REAL(wp), PUBLIC, DIMENSION(jpk)         ::   &  ! ** 1D coefficients ** 
     68   REAL(wp), PUBLIC, DIMENSION(jpk)         ::   &  !: ** 1D coefficients ** 
    6969# else 
    70    REAL(wp), PUBLIC                         ::   &  ! ** 0D coefficients ** 
     70   REAL(wp), PUBLIC                         ::   &  !: ** 0D coefficients ** 
    7171# endif 
    72       aeiu, aeiv, aeiw                              ! U-, V-, W-points  induced velocity coef. (m2/s) 
     72      aeiu, aeiv, aeiw                              !: U-, V-, W-points  induced velocity coef. (m2/s) 
    7373 
    7474# if defined key_diaeiv 
    75    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::    & 
    76       u_eiv,      &  ! The three component of the eddy induced velocity (m/s) 
    77       v_eiv,      &  ! saved for diagnostics and/or outputs 
    78       w_eiv          !  
     75   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::    &  !: 
     76      u_eiv, v_eiv, w_eiv     !: The three component of the eddy induced velocity (m/s) 
    7977# endif 
    8078 
    … …  
    8381   !!   Default option :                           NO eddy induced velocity 
    8482   !!---------------------------------------------------------------------- 
    85    LOGICAL , PUBLIC, PARAMETER ::   lk_traldf_eiv   = .FALSE.   ! eddy induced velocity flag 
     83   LOGICAL , PUBLIC, PARAMETER ::   lk_traldf_eiv   = .FALSE.   !: eddy induced velocity flag 
    8684   REAL(wp), PUBLIC ::   aeiu, aeiv, aeiw 
    8785#endif 

  • trunk/NEMO/OPA_SRC/OBC/obc_oce.F90

    r3 r32  
    2525   !!General variables for open boundaries: 
    2626   !!-------------------------------------- 
    27    INTEGER ::              & 
    28       numrob = 51   ,      & ! logical units for open boundary input restart files 
    29       numwob = 52   ,      & ! logical units for open boundary output restart files 
    30                              ! 
    31       nbobc         ,      & ! number of open boundaries ( 1=< nbobc =< 4 )  
    32       nobc_dta      ,      & !  = 0 use the initial state as obc data 
    33        !                     !  = 1 read obc data in obcxxx.dta files 
    34       nmoisold      ,      & ! number of the last read month on the OBC 
    35       nbef, naft             ! index of the aftera and before fields on the OBC  
    36  
    37    REAL(wp) ::             & !!! open boundary namelist (namobc) 
    38       rdpein =  1.  ,      &  ! damping time scale for inflow at East open boundary 
    39       rdpwin =  1.  ,      &  !    "                      "   at West open boundary 
    40       rdpsin =  1.  ,      &  !    "                      "   at South open boundary 
    41       rdpnin =  1.  ,      &  !    "                      "   at North open boundary 
    42       rdpeob = 15.  ,      &  ! damping time scale for the climatology at East open boundary 
    43       rdpwob = 15.  ,      &  !    "                           "       at West open boundary 
    44       rdpsob = 15.  ,      &  !    "                           "       at South open boundary 
    45       rdpnob = 15.  ,      &  !    "                           "       at North open boundary 
    46       volemp =  1.            ! = 0 the total volume will have the variability of the  
    47                               !     surface Flux E-P else (volemp = 1) the volume will be constant 
    48                               ! = 1 the volume will be constant during all the integration. 
    49  
    50    LOGICAL ::              &  
    51       lfbceast, lfbcwest,  & ! logical flag for a fixed East and West open boundaries        
    52       lfbcnorth, lfbcsouth   ! logical flag for a fixed North and South open boundaries        
    53                              ! These logical flags are set to 'true' if damping time  
    54                              ! scale are set to 0 in the namelist, for both inflow and outflow). 
    55  
    56    REAL(wp), DIMENSION(jpi,jpj) :: & 
    57       obctmsk                ! mask array identical to tmask, execpt along OBC where it is set to 0 
    58                              ! it used to calculate the cumulate flux E-P in the obcvol.F90 routine 
     27   INTEGER ::              & !: * namelist ??? * 
     28      nbobc    = 1  ,      & !: number of open boundaries ( 1=< nbobc =< 4 )  
     29      nobc_dta = 0  ,      & !:  = 0 use the initial state as obc data 
     30      !                      !   = 1 read obc data in obcxxx.dta files 
     31      nmoisold      ,      & !: number of the last read month on the OBC 
     32      nbef, naft             !: index of the aftera and before fields on the OBC  
     33 
     34   REAL(wp) ::             & !!: open boundary namelist (namobc) 
     35      rdpein =  1.  ,      &  !: damping time scale for inflow at East open boundary 
     36      rdpwin =  1.  ,      &  !:    "                      "   at West open boundary 
     37      rdpsin =  1.  ,      &  !:    "                      "   at South open boundary 
     38      rdpnin =  1.  ,      &  !:    "                      "   at North open boundary 
     39      rdpeob = 15.  ,      &  !: damping time scale for the climatology at East open boundary 
     40      rdpwob = 15.  ,      &  !:    "                           "       at West open boundary 
     41      rdpsob = 15.  ,      &  !:    "                           "       at South open boundary 
     42      rdpnob = 15.  ,      &  !:    "                           "       at North open boundary 
     43      volemp =  1.            !: = 0 the total volume will have the variability of the  
     44                              !      surface Flux E-P else (volemp = 1) the volume will be constant 
     45                              !  = 1 the volume will be constant during all the integration. 
     46 
     47   LOGICAL ::              &  !: 
     48      lfbceast, lfbcwest,  &  !: logical flag for a fixed East and West open boundaries        
     49      lfbcnorth, lfbcsouth    !: logical flag for a fixed North and South open boundaries        
     50      !                       !  These logical flags are set to 'true' if damping time  
     51      !                       !  scale are set to 0 in the namelist, for both inflow and outflow). 
     52 
     53   REAL(wp), DIMENSION(jpi,jpj) :: &  !: 
     54      obctmsk                !: mask array identical to tmask, execpt along OBC where it is set to 0 
     55      !                      !  it used to calculate the cumulate flux E-P in the obcvol.F90 routine 
    5956          
    60    !!------------------------------------------------------------------------------------------- 
     57   !!---------------- 
    6158   !! Rigid lid case: 
    6259   !!---------------- 
    63    INTEGER ::   nbic ! number of isolated coastlines ( 0 <= nbic <= 3 ) 
     60   INTEGER ::   nbic !: number of isolated coastlines ( 0 <= nbic <= 3 ) 
    6461          
    65    INTEGER, DIMENSION(jpnic,0:4,3) ::   & 
    66       miic, mjic     ! position of isolated coastlines points 
    67  
    68    INTEGER, DIMENSION(0:4,3) ::   & 
    69       mnic           ! number of points on isolated coastlines 
    70  
    71    REAL(wp), DIMENSION(jpi,jpj) ::   & 
    72       gcbob          ! right hand side of the barotropic elliptic equation associated 
    73                      ! with the OBC 
     62   INTEGER, DIMENSION(jpnic,0:4,3) ::   &  !: 
     63      miic, mjic     !: position of isolated coastlines points 
     64 
     65   INTEGER, DIMENSION(0:4,3) ::   &  !: 
     66      mnic           !: number of points on isolated coastlines 
     67 
     68   REAL(wp), DIMENSION(jpi,jpj) ::   &  !: 
     69      gcbob          !: right hand side of the barotropic elliptic equation associated 
     70      !              ! with the OBC 
    7471                                              
    75    REAL(wp), DIMENSION(jpi,jpj,3) ::   & 
    76       gcfobc         ! coef. associated with the contribution of isolated coastlines  
    77                      ! to the right hand side of the barotropic elliptic equation 
    78  
    79    REAL(wp), DIMENSION(3) ::   & 
    80       gcbic          ! time variation of the barotropic stream function along the  
    81                      ! isolated coastlines  
    82  
    83    REAL(wp), DIMENSION(1) ::   & 
    84       bsfic0         ! barotropic stream function on isolated coastline 
     72   REAL(wp), DIMENSION(jpi,jpj,3) ::   &  !: 
     73      gcfobc         !: coef. associated with the contribution of isolated coastlines  
     74      !              ! to the right hand side of the barotropic elliptic equation 
     75 
     76   REAL(wp), DIMENSION(3) ::   &  !: 
     77      gcbic          !: time variation of the barotropic stream function along the  
     78      !              ! isolated coastlines  
     79 
     80   REAL(wp), DIMENSION(1) ::   &  !: 
     81      bsfic0         !: barotropic stream function on isolated coastline 
    8582          
    86    REAL(wp), DIMENSION(3) ::   & 
    87       bsfic          ! barotropic stream function on isolated coastline 
     83   REAL(wp), DIMENSION(3) ::   &  !: 
     84      bsfic          !: barotropic stream function on isolated coastline 
    8885          
    89    !!------------------------------------------------------------------------------------------- 
     86   !!-------------------- 
    9087   !! East open boundary: 
    9188   !!-------------------- 
    92    INTEGER ::   nie0  , nie1      ! do loop index in mpp case for jpieob 
    93    INTEGER ::   nie0p1, nie1p1    ! do loop index in mpp case for jpieob+1 
    94    INTEGER ::   nie0m1, nie1m1    ! do loop index in mpp case for jpieob-1 
    95    INTEGER ::   nje0  , nje1      ! do loop index in mpp case for jpjed, jpjef 
    96    INTEGER ::   nje0p1, nje1m1    ! do loop index in mpp case for jpjedp1,jpjefm1 
    97    INTEGER ::   nje1m2, nje0m1    ! do loop index in mpp case for jpjefm1-1,jpjed 
    98  
    99    REAL(wp), DIMENSION(jpj) ::    & 
    100       bsfeob              ! now barotropic stream fuction computed at the OBC. The corres- 
    101                           ! ponding bsfn will be computed by the forward time step in dynspg. 
    102  
    103    REAL(wp), DIMENSION(jpj,3,3) ::   & 
    104       bebnd               ! east boundary barotropic streamfunction over 3 rows 
    105                           ! and 3 time step (now, before, and before before) 
    106  
    107    REAL(wp), DIMENSION(jpjed:jpjef) ::   & 
    108       bfoe                ! now climatology of the east boundary barotropic stream function  
     89   INTEGER ::   nie0  , nie1      !: do loop index in mpp case for jpieob 
     90   INTEGER ::   nie0p1, nie1p1    !: do loop index in mpp case for jpieob+1 
     91   INTEGER ::   nie0m1, nie1m1    !: do loop index in mpp case for jpieob-1 
     92   INTEGER ::   nje0  , nje1      !: do loop index in mpp case for jpjed, jpjef 
     93   INTEGER ::   nje0p1, nje1m1    !: do loop index in mpp case for jpjedp1,jpjefm1 
     94   INTEGER ::   nje1m2, nje0m1    !: do loop index in mpp case for jpjefm1-1,jpjed 
     95 
     96   REAL(wp), DIMENSION(jpj) ::    &  !: 
     97      bsfeob              !: now barotropic stream fuction computed at the OBC. The corres- 
     98      !                   ! ponding bsfn will be computed by the forward time step in dynspg. 
     99 
     100   REAL(wp), DIMENSION(jpj,3,3) ::   &  !: 
     101      bebnd               !: east boundary barotropic streamfunction over 3 rows 
     102      !                   ! and 3 time step (now, before, and before before) 
     103 
     104   REAL(wp), DIMENSION(jpjed:jpjef) ::   &  !: 
     105      bfoe                !: now climatology of the east boundary barotropic stream function  
    109106      
    110    REAL(wp), DIMENSION(jpj,jpk) ::   & 
    111       ufoe, vfoe,       & ! now climatology of the east boundary velocities  
    112       tfoe, sfoe,       & ! now climatology of the east boundary temperature and salinity 
    113       uclie               ! baroclinic componant of the zonal velocity after radiation  
    114                           ! in the obcdyn.F90 routine 
    115  
    116    REAL(wp), DIMENSION(jpjglo,jpk,1) ::   & 
    117       uedta, tedta, sedta ! array used for interpolating monthly data on the east boundary 
    118  
    119    !!------------------------------------------------------------------------------------------- 
     107   REAL(wp), DIMENSION(jpj,jpk) ::   &  !: 
     108      ufoe, vfoe,       & !: now climatology of the east boundary velocities  
     109      tfoe, sfoe,       & !: now climatology of the east boundary temperature and salinity 
     110      uclie               !: baroclinic componant of the zonal velocity after radiation  
     111      !                   ! in the obcdyn.F90 routine 
     112 
     113   REAL(wp), DIMENSION(jpjglo,jpk,1) ::   &  !: 
     114      uedta, tedta, sedta !: array used for interpolating monthly data on the east boundary 
     115 
     116   !!------------------------------- 
    120117   !! Arrays for radiative East OBC:  
    121118   !!------------------------------- 
    122    !!    
    123    REAL(wp), DIMENSION(jpj,jpk,3,3) ::   & 
    124       uebnd, vebnd                  ! baroclinic u & v component of the velocity over 3 rows  
     119   REAL(wp), DIMENSION(jpj,jpk,3,3) ::   &  !: 
     120      uebnd, vebnd                  !: baroclinic u & v component of the velocity over 3 rows  
    125121                                    ! and 3 time step (now, before, and before before) 
    126122 
    127    REAL(wp), DIMENSION(jpj,jpk,2,2) ::   & 
    128       tebnd, sebnd                  ! East boundary temperature and salinity over 2 rows  
     123   REAL(wp), DIMENSION(jpj,jpk,2,2) ::   &  !: 
     124      tebnd, sebnd                  !: East boundary temperature and salinity over 2 rows  
    129125                                    ! and 2 time step (now and before) 
    130126 
    131    REAL(wp), DIMENSION(jpj,jpk) ::   & 
    132       u_cxebnd, v_cxebnd            ! Zonal component of the phase speed ratio computed with  
     127   REAL(wp), DIMENSION(jpj,jpk) ::   &  !: 
     128      u_cxebnd, v_cxebnd            !: Zonal component of the phase speed ratio computed with  
    133129                                    ! radiation of u and v velocity (respectively) at the  
    134130                                    ! east open boundary (u_cxebnd = cx rdt ) 
    135131 
    136    REAL(wp), DIMENSION(jpj,jpk) ::   & 
    137       uemsk, vemsk, temsk           ! 2D mask for the East OB 
     132   REAL(wp), DIMENSION(jpj,jpk) ::   &  !: 
     133      uemsk, vemsk, temsk           !: 2D mask for the East OB 
    138134 
    139135   ! Note that those arrays are optimized for mpp case  
    140136   ! (hence the dimension jpj is the size of one processor subdomain) 
    141137 
    142    !!------------------------------------------------------------------------------------------- 
    143    !! West open boundary: 
    144138   !!-------------------- 
    145    INTEGER ::   niw0  , niw1       ! do loop index in mpp case for jpiwob 
    146    INTEGER ::   niw0p1, niw1p1     ! do loop index in mpp case for jpiwob+1 
    147    INTEGER ::   njw0  , njw1       ! do loop index in mpp case for jpjwd, jpjwf 
    148    INTEGER ::   njw0p1, njw1m1     ! do loop index in mpp case for jpjwdp1,jpjwfm1 
    149    INTEGER ::   njw1m2, njw0m1     ! do loop index in mpp case for jpjwfm2,jpjwd 
    150  
    151    REAL(wp), DIMENSION(jpj) ::   & 
    152       bsfwob              ! now barotropic stream fuction computed at the OBC. The corres- 
    153                           ! ponding bsfn will be computed by the forward time step in dynspg. 
    154  
    155    REAL(wp), DIMENSION(jpj,3,3) ::   & 
    156       bwbnd               ! West boundary barotropic streamfunction over 
    157                           ! 3 rows and 3 time step (now, before, and before before) 
    158  
    159    REAL(wp), DIMENSION(jpjwd:jpjwf) ::   & 
    160       bfow                ! now climatology of the west boundary barotropic stream function 
    161  
    162    REAL(wp), DIMENSION(jpj,jpk) ::   & 
    163       ufow, vfow,       & ! now climatology of the west velocities  
    164       tfow, sfow,       & ! now climatology of the west temperature and salinity 
    165       ucliw               ! baroclinic componant of the zonal velocity after the radiation  
    166                           ! in the obcdyn.F90 routine 
    167  
    168    REAL(wp), DIMENSION(jpjglo,jpk,1) ::   & 
    169       uwdta, twdta, swdta ! array used for interpolating monthly data on the west boundary 
    170  
    171    !!------------------------------------------------------------------------------------------- 
    172    !! Arrays for radiative West OBC: 
     139   !! West open boundary 
     140   !!-------------------- 
     141   INTEGER ::   niw0  , niw1       !: do loop index in mpp case for jpiwob 
     142   INTEGER ::   niw0p1, niw1p1     !: do loop index in mpp case for jpiwob+1 
     143   INTEGER ::   njw0  , njw1       !: do loop index in mpp case for jpjwd, jpjwf 
     144   INTEGER ::   njw0p1, njw1m1     !: do loop index in mpp case for jpjwdp1,jpjwfm1 
     145   INTEGER ::   njw1m2, njw0m1     !: do loop index in mpp case for jpjwfm2,jpjwd 
     146 
     147   REAL(wp), DIMENSION(jpj) ::   &  !: 
     148      bsfwob              !: now barotropic stream fuction computed at the OBC. The corres- 
     149      !                   !  ponding bsfn will be computed by the forward time step in dynspg. 
     150 
     151   REAL(wp), DIMENSION(jpj,3,3) ::   &  !: 
     152      bwbnd               !: West boundary barotropic streamfunction over 
     153      !                   !  3 rows and 3 time step (now, before, and before before) 
     154 
     155   REAL(wp), DIMENSION(jpjwd:jpjwf) ::   &  !: 
     156      bfow                !: now climatology of the west boundary barotropic stream function 
     157 
     158   REAL(wp), DIMENSION(jpj,jpk) ::   &  !: 
     159      ufow, vfow,       & !: now climatology of the west velocities  
     160      tfow, sfow,       & !: now climatology of the west temperature and salinity 
     161      ucliw               !: baroclinic componant of the zonal velocity after the radiation  
     162      !                   !  in the obcdyn.F90 routine 
     163 
     164   REAL(wp), DIMENSION(jpjglo,jpk,1) ::   &  !: 
     165      uwdta, twdta, swdta !: array used for interpolating monthly data on the west boundary 
     166 
    173167   !!------------------------------- 
    174    !!    
    175    REAL(wp), DIMENSION(jpj,jpk,3,3) ::   & 
    176       uwbnd, vwbnd                  ! baroclinic u & v components of the velocity over 3 rows  
    177                                     ! and 3 time step (now, before, and before before) 
    178  
    179    REAL(wp), DIMENSION(jpj,jpk,2,2) ::   & 
    180       twbnd, swbnd                  ! west boundary temperature and salinity over 2 rows and  
    181                                     ! 2 time step (now and before) 
    182  
    183    REAL(wp), DIMENSION(jpj,jpk) ::    & 
    184       u_cxwbnd, v_cxwbnd            ! Zonal component of the phase speed ratio computed with  
    185                                     ! radiation of zonal and meridional velocity (respectively)  
    186                                     ! at the west open boundary (u_cxwbnd = cx rdt ) 
    187  
    188    REAL(wp), DIMENSION(jpj,jpk) ::    & 
    189       uwmsk, vwmsk, twmsk           ! 2D mask for the West OB 
     168   !! Arrays for radiative West OBC 
     169   !!------------------------------- 
     170   REAL(wp), DIMENSION(jpj,jpk,3,3) ::   &  !: 
     171      uwbnd, vwbnd                  !: baroclinic u & v components of the velocity over 3 rows  
     172      !                             !  and 3 time step (now, before, and before before) 
     173 
     174   REAL(wp), DIMENSION(jpj,jpk,2,2) ::   &  !: 
     175      twbnd, swbnd                  !: west boundary temperature and salinity over 2 rows and  
     176      !                             !  2 time step (now and before) 
     177 
     178   REAL(wp), DIMENSION(jpj,jpk) ::    &  !: 
     179      u_cxwbnd, v_cxwbnd            !: Zonal component of the phase speed ratio computed with  
     180      !                             !  radiation of zonal and meridional velocity (respectively)  
     181      !                             !  at the west open boundary (u_cxwbnd = cx rdt ) 
     182 
     183   REAL(wp), DIMENSION(jpj,jpk) ::    &  !: 
     184      uwmsk, vwmsk, twmsk           !: 2D mask for the West OB 
    190185 
    191186   ! Note that those arrays are optimized for mpp case  
    192187   ! (hence the dimension jpj is the size of one processor subdomain) 
    193188 
    194    !!------------------------------------------------------------------------------------------- 
    195    !! North open boundary: 
    196189   !!--------------------- 
    197    INTEGER ::   nin0  , nin1       ! do loop index in mpp case for jpind, jpinf 
    198    INTEGER ::   nin0p1, nin1m1     ! do loop index in mpp case for jpindp1, jpinfm1 
    199    INTEGER ::   nin1m2, nin0m1     ! do loop index in mpp case for jpinfm1-1,jpind 
    200    INTEGER ::   njn0  , njn1       ! do loop index in mpp case for jpnob 
    201    INTEGER ::   njn0p1, njn1p1     ! do loop index in mpp case for jpnob+1 
    202    INTEGER ::   njn0m1, njn1m1     ! do loop index in mpp case for jpnob-1 
    203  
    204    REAL(wp), DIMENSION(jpi) ::   & 
    205       bsfnob              ! now barotropic stream fuction computed at the OBC. The corres- 
    206                           ! ponding bsfn will be computed by the forward time step in dynspg. 
    207  
    208    REAL(wp), DIMENSION(jpi,3,3) ::   & 
    209       bnbnd               ! north boundary barotropic streamfunction over 
    210                           ! 3 rows and 3 time step (now, before, and before before) 
    211  
    212    REAL(wp), DIMENSION(jpind:jpinf) ::   & 
    213       bfon                ! now climatology of the north boundary barotropic stream function 
    214  
    215    REAL(wp), DIMENSION(jpi,jpk) ::   &   
    216       ufon, vfon,       & ! now climatology of the north boundary velocities 
    217       tfon, sfon,       & ! now climatology of the north boundary temperature and salinity 
    218       vclin               ! baroclinic componant of the meridian velocity after the radiation 
    219                           ! in yhe obcdyn.F90 routine 
    220  
    221    REAL(wp), DIMENSION(jpiglo,jpk,1) ::   & 
    222       vndta, tndta, sndta ! array used for interpolating monthly data on the north boundary 
    223  
    224    !!------------------------------------------------------------------------------------------- 
    225    !! Arrays for radiative North OBC: 
     190   !! North open boundary 
     191   !!--------------------- 
     192   INTEGER ::   nin0  , nin1       !: do loop index in mpp case for jpind, jpinf 
     193   INTEGER ::   nin0p1, nin1m1     !: do loop index in mpp case for jpindp1, jpinfm1 
     194   INTEGER ::   nin1m2, nin0m1     !: do loop index in mpp case for jpinfm1-1,jpind 
     195   INTEGER ::   njn0  , njn1       !: do loop index in mpp case for jpnob 
     196   INTEGER ::   njn0p1, njn1p1     !: do loop index in mpp case for jpnob+1 
     197   INTEGER ::   njn0m1, njn1m1     !: do loop index in mpp case for jpnob-1 
     198 
     199   REAL(wp), DIMENSION(jpi) ::   &  !: 
     200      bsfnob              !: now barotropic stream fuction computed at the OBC. The corres- 
     201      !                   !  ponding bsfn will be computed by the forward time step in dynspg. 
     202 
     203   REAL(wp), DIMENSION(jpi,3,3) ::   &  !: 
     204      bnbnd               !: north boundary barotropic streamfunction over 
     205      !                   !  3 rows and 3 time step (now, before, and before before) 
     206 
     207   REAL(wp), DIMENSION(jpind:jpinf) ::   &  !: 
     208      bfon                !: now climatology of the north boundary barotropic stream function 
     209 
     210   REAL(wp), DIMENSION(jpi,jpk) ::   &    !: 
     211      ufon, vfon,       & !: now climatology of the north boundary velocities 
     212      tfon, sfon,       & !: now climatology of the north boundary temperature and salinity 
     213      vclin               !: baroclinic componant of the meridian velocity after the radiation 
     214      !                   !  in yhe obcdyn.F90 routine 
     215 
     216   REAL(wp), DIMENSION(jpiglo,jpk,1) ::   &  !: 
     217      vndta, tndta, sndta !: array used for interpolating monthly data on the north boundary 
     218 
     219   !!-------------------------------- 
     220   !! Arrays for radiative North OBC 
    226221   !!-------------------------------- 
    227222   !!    
    228    REAL(wp), DIMENSION(jpi,jpk,3,3) ::   &  
    229       unbnd, vnbnd                  ! baroclinic u & v components of the velocity over 3 
    230                                     ! rows and 3 time step (now, before, and before before) 
    231  
    232    REAL(wp), DIMENSION(jpi,jpk,2,2) ::   &  
    233       tnbnd, snbnd                  ! north boundary temperature and salinity over 
    234                                     ! 2 rows and 2 time step (now and before) 
    235  
    236    REAL(wp), DIMENSION(jpi,jpk) ::   &    
    237       u_cynbnd, v_cynbnd            ! Meridional component of the phase speed ratio compu- 
    238                                     ! ted with radiation of zonal and meridional velocity  
    239                                     ! (respectively) at the north OB (u_cynbnd = cx rdt ) 
    240  
    241    REAL(wp), DIMENSION(jpi,jpk) ::   & 
    242       unmsk, vnmsk, tnmsk           ! 2D mask for the North OB 
     223   REAL(wp), DIMENSION(jpi,jpk,3,3) ::   &   !: 
     224      unbnd, vnbnd                  !: baroclinic u & v components of the velocity over 3 
     225      !                             ! rows and 3 time step (now, before, and before before) 
     226 
     227   REAL(wp), DIMENSION(jpi,jpk,2,2) ::   &   !: 
     228      tnbnd, snbnd                  !: north boundary temperature and salinity over 
     229      !                             ! 2 rows and 2 time step (now and before) 
     230 
     231   REAL(wp), DIMENSION(jpi,jpk) ::   &     !: 
     232      u_cynbnd, v_cynbnd            !: Meridional component of the phase speed ratio compu- 
     233      !                             ! ted with radiation of zonal and meridional velocity  
     234      !                             ! (respectively) at the north OB (u_cynbnd = cx rdt ) 
     235 
     236   REAL(wp), DIMENSION(jpi,jpk) ::   &  !: 
     237      unmsk, vnmsk, tnmsk           !: 2D mask for the North OB 
    243238 
    244239   ! Note that those arrays are optimized for mpp case  
    245240   ! (hence the dimension jpj is the size of one processor subdomain) 
    246241    
    247    !!------------------------------------------------------------------------------------------- 
    248    !! South open boundary: 
    249242   !!--------------------- 
    250    INTEGER ::   nis0  , nis1       ! do loop index in mpp case for jpisd, jpisf 
    251    INTEGER ::   nis0p1, nis1m1     ! do loop index in mpp case for jpisdp1, jpisfm1 
    252    INTEGER ::   nis1m2, nis0m1     ! do loop index in mpp case for jpisfm1-1,jpisd 
    253    INTEGER ::   njs0  , njs1       ! do loop index in mpp case for jpsob 
    254    INTEGER ::   njs0p1, njs1p1     ! do loop index in mpp case for jpsob+1 
    255  
    256    REAL(wp), DIMENSION(jpi) ::    &  
    257       bsfsob              ! now barotropic stream fuction computed at the OBC.The corres- 
    258                           ! ponding bsfn will be computed by the forward time step in dynspg. 
    259    REAL(wp), DIMENSION(jpi,3,3) ::   &  
    260       bsbnd               ! south boundary barotropic stream function over 
    261                           ! 3 rows and 3 time step (now, before, and before before) 
    262  
    263    REAL(wp), DIMENSION(jpisd:jpisf) ::    &  
    264       bfos                ! now climatology of the south boundary barotropic stream function 
    265  
    266    REAL(wp), DIMENSION(jpi,jpk) ::    &  
    267       ufos, vfos,       & ! now climatology of the south boundary velocities  
    268       tfos, sfos,       & ! now climatology of the south boundary temperature and salinity 
    269       vclis               ! baroclinic componant of the meridian velocity after the radiation  
    270                           ! in the obcdyn.F90 routine 
    271  
    272    REAL(wp), DIMENSION(jpiglo,jpk,1) ::    &   
    273       vsdta, tsdta, ssdta   ! array used for interpolating monthly data on the south boundary 
    274  
    275    !!------------------------------------------------------------------------------------------- 
    276    !! Arrays for radiative South OBC: 
     243   !! South open boundary 
     244   !!--------------------- 
     245   INTEGER ::   nis0  , nis1       !: do loop index in mpp case for jpisd, jpisf 
     246   INTEGER ::   nis0p1, nis1m1     !: do loop index in mpp case for jpisdp1, jpisfm1 
     247   INTEGER ::   nis1m2, nis0m1     !: do loop index in mpp case for jpisfm1-1,jpisd 
     248   INTEGER ::   njs0  , njs1       !: do loop index in mpp case for jpsob 
     249   INTEGER ::   njs0p1, njs1p1     !: do loop index in mpp case for jpsob+1 
     250 
     251   REAL(wp), DIMENSION(jpi) ::    &   !: 
     252      bsfsob              !: now barotropic stream fuction computed at the OBC.The corres- 
     253      !                   !  ponding bsfn will be computed by the forward time step in dynspg. 
     254   REAL(wp), DIMENSION(jpi,3,3) ::   &   !: 
     255      bsbnd               !: south boundary barotropic stream function over 
     256      !                   !  3 rows and 3 time step (now, before, and before before) 
     257 
     258   REAL(wp), DIMENSION(jpisd:jpisf) ::    &   !: 
     259      bfos                !: now climatology of the south boundary barotropic stream function 
     260 
     261   REAL(wp), DIMENSION(jpi,jpk) ::    &   !: 
     262      ufos, vfos,       & !: now climatology of the south boundary velocities  
     263      tfos, sfos,       & !: now climatology of the south boundary temperature and salinity 
     264      vclis               !: baroclinic componant of the meridian velocity after the radiation  
     265      !                   !  in the obcdyn.F90 routine 
     266 
     267   REAL(wp), DIMENSION(jpiglo,jpk,1) ::    &    !: 
     268      vsdta, tsdta, ssdta   !: array used for interpolating monthly data on the south boundary 
     269 
     270   !!-------------------------------- 
     271   !! Arrays for radiative South OBC 
    277272   !!-------------------------------- 
    278273   !!                        computed by the forward time step in dynspg. 
    279    REAL(wp), DIMENSION(jpi,jpk,3,3) ::   &  
    280       usbnd, vsbnd                  ! baroclinic u & v components of the velocity over 3  
    281                                     ! rows and 3 time step (now, before, and before before) 
    282  
    283    REAL(wp), DIMENSION(jpi,jpk,2,2) ::   & 
    284       tsbnd, ssbnd                  ! south boundary temperature and salinity over 
    285                                     ! 2 rows and 2 time step (now and before) 
    286  
    287    REAL(wp), DIMENSION(jpi,jpk) ::   & 
    288       u_cysbnd, v_cysbnd            ! Meridional component of the phase speed ratio compu- 
    289                                     ! ted with radiation of zonal and meridional velocity  
    290                                     ! (repsectively) at the south OB (u_cynbnd = cx rdt ) 
    291  
    292    REAL(wp), DIMENSION(jpi,jpk) ::   & 
    293       usmsk, vsmsk, tsmsk           ! 2D mask for the South OB 
     274   REAL(wp), DIMENSION(jpi,jpk,3,3) ::   &   !: 
     275      usbnd, vsbnd                  !: baroclinic u & v components of the velocity over 3  
     276      !                             ! rows and 3 time step (now, before, and before before) 
     277 
     278   REAL(wp), DIMENSION(jpi,jpk,2,2) ::   &  !: 
     279      tsbnd, ssbnd                  !: south boundary temperature and salinity over 
     280      !                             ! 2 rows and 2 time step (now and before) 
     281 
     282   REAL(wp), DIMENSION(jpi,jpk) ::   &  !: 
     283      u_cysbnd, v_cysbnd            !: Meridional component of the phase speed ratio compu- 
     284      !                             ! ted with radiation of zonal and meridional velocity  
     285      !                             ! (repsectively) at the south OB (u_cynbnd = cx rdt ) 
     286 
     287   REAL(wp), DIMENSION(jpi,jpk) ::   &  !: 
     288      usmsk, vsmsk, tsmsk           !: 2D mask for the South OB 
    294289 
    295290   ! Note that those arrays are optimized for mpp case  
    … …  
    301296   !!---------------------------------------------------------------------- 
    302297#endif 
     298 
    303299   !!====================================================================== 
    304300END MODULE obc_oce 

  • trunk/NEMO/OPA_SRC/OBC/obc_par.F90

    r3 r32  
    1818   PUBLIC 
    1919 
    20    LOGICAL, PUBLIC, PARAMETER ::   lk_obc = .TRUE.   ! Ocean Boundary Condition flag 
     20   LOGICAL, PUBLIC, PARAMETER ::   lk_obc = .TRUE.   !: Ocean Boundary Condition flag 
    2121 
    2222# if defined key_eel_r5 
    … …  
    3131   !!--------------------------------------------------------------------- 
    3232   !! * EAST open boundary 
    33    LOGICAL, PARAMETER ::     & 
    34       lpeastobc = .FALSE.       ! to active or not the East open boundary 
    35    INTEGER, PARAMETER ::     & 
    36       jpieob  = jpiglo-2,    &  ! i-localization of the East open boundary (must be ocean U-point) 
    37       jpjed   =        2,    &  ! j-starting indice of the East open boundary (must be land T-point) 
    38       jpjef   = jpjglo-1,    &  ! j-ending   indice of the East open boundary (must be land T-point) 
    39       jpjedp1 =  jpjed+1,    &  ! first ocean point         "                 " 
    40       jpjefm1 =  jpjef-1        ! last  ocean point         "                 " 
     33   LOGICAL, PARAMETER ::     &  !: 
     34      lpeastobc = .FALSE.       !: to active or not the East open boundary 
     35   INTEGER, PARAMETER ::     &  !: 
     36      jpieob  = jpiglo-2,    &  !: i-localization of the East open boundary (must be ocean U-point) 
     37      jpjed   =        2,    &  !: j-starting indice of the East open boundary (must be land T-point) 
     38      jpjef   = jpjglo-1,    &  !: j-ending   indice of the East open boundary (must be land T-point) 
     39      jpjedp1 =  jpjed+1,    &  !: first ocean point         "                 " 
     40      jpjefm1 =  jpjef-1        !: last  ocean point         "                 " 
    4141 
    4242   !! * WEST open boundary 
    43    LOGICAL, PARAMETER ::     & 
    44       lpwestobc = .FALSE.       ! to active or not the West open boundary 
    45    INTEGER, PARAMETER ::     & 
    46       jpiwob  =          2,    &  ! i-localization of the West open boundary (must be ocean U-point) 
    47       jpjwd   =          2,    &  ! j-starting indice of the West open boundary (must be land T-point) 
    48       jpjwf   = jpjglo-1,    &  ! j-ending   indice of the West open boundary (must be land T-point) 
    49       jpjwdp1 =  jpjwd+1,    &  ! first ocean point         "                 " 
    50       jpjwfm1 =  jpjwf-1        ! last  ocean point         "                 " 
     43   LOGICAL, PARAMETER ::     &  !: 
     44      lpwestobc = .FALSE.       !: to active or not the West open boundary 
     45   INTEGER, PARAMETER ::     &  !: 
     46      jpiwob  =          2,    &  !: i-localization of the West open boundary (must be ocean U-point) 
     47      jpjwd   =          2,    &  !: j-starting indice of the West open boundary (must be land T-point) 
     48      jpjwf   = jpjglo-1,    &  !: j-ending   indice of the West open boundary (must be land T-point) 
     49      jpjwdp1 =  jpjwd+1,    &  !: first ocean point         "                 " 
     50      jpjwfm1 =  jpjwf-1        !: last  ocean point         "                 " 
    5151 
    5252   !! * NORTH open boundary 
    53    LOGICAL, PARAMETER ::    & 
    54       lpnorthobc = .FALSE.      ! to active or not the North open boundary 
    55    INTEGER, PARAMETER ::     & 
    56       jpjnob  = jpjglo-2,    &  ! j-localization of the North open boundary (must be ocean V-point) 
    57       jpind   =        2,    &  ! i-starting indice of the North open boundary (must be land T-point) 
    58       jpinf   = jpiglo-1,    &  ! i-ending   indice of the North open boundary (must be land T-point) 
    59       jpindp1 =  jpind+1,    &  ! first ocean point         "                 " 
    60       jpinfm1 =  jpinf-1        ! last  ocean point         "                 " 
     53   LOGICAL, PARAMETER ::     &  !: 
     54      lpnorthobc = .FALSE.      !: to active or not the North open boundary 
     55   INTEGER, PARAMETER ::     &  !: 
     56      jpjnob  = jpjglo-2,    &  !: j-localization of the North open boundary (must be ocean V-point) 
     57      jpind   =        2,    &  !: i-starting indice of the North open boundary (must be land T-point) 
     58      jpinf   = jpiglo-1,    &  !: i-ending   indice of the North open boundary (must be land T-point) 
     59      jpindp1 =  jpind+1,    &  !: first ocean point         "                 " 
     60      jpinfm1 =  jpinf-1        !: last  ocean point         "                 " 
    6161 
    6262   !! * SOUTH open boundary 
    63    LOGICAL, PARAMETER ::     & 
    64       lpsouthobc = .FALSE.      ! to active or not the South open boundary 
    65    INTEGER, PARAMETER ::     & 
    66       jpjsob  =        2,    &  ! j-localization of the South open boundary (must be ocean V-point) 
    67       jpisd   =        2,    &  ! i-starting indice of the South open boundary (must be land T-point) 
    68       jpisf   = jpiglo-1,    &  ! i-ending   indice of the South open boundary (must be land T-point) 
    69       jpisdp1 =  jpisd+1,    &  ! first ocean point         "                 " 
    70       jpisfm1 =  jpisf-1        ! last  ocean point         "                 " 
     63   LOGICAL, PARAMETER ::     &  !: 
     64      lpsouthobc = .FALSE.      !: to active or not the South open boundary 
     65   INTEGER, PARAMETER ::     &  !: 
     66      jpjsob  =        2,    &  !: j-localization of the South open boundary (must be ocean V-point) 
     67      jpisd   =        2,    &  !: i-starting indice of the South open boundary (must be land T-point) 
     68      jpisf   = jpiglo-1,    &  !: i-ending   indice of the South open boundary (must be land T-point) 
     69      jpisdp1 =  jpisd+1,    &  !: first ocean point         "                 " 
     70      jpisfm1 =  jpisf-1        !: last  ocean point         "                 " 
    7171    
    72    INTEGER, PARAMETER ::     & 
    73       jpnic = 2700              ! maximum number of isolated coastlines points  
     72   INTEGER, PARAMETER ::     &  !: 
     73      jpnic = 2700              !: maximum number of isolated coastlines points  
    7474 
    7575# endif 
    … …  
    7979   !!   Default option :                         NO open boundary condition 
    8080   !!---------------------------------------------------------------------- 
    81    LOGICAL, PUBLIC, PARAMETER ::   lk_obc = .FALSE.  ! Ocean Boundary Condition flag 
     81   LOGICAL, PUBLIC, PARAMETER ::   lk_obc = .FALSE.  !: Ocean Boundary Condition flag 
    8282#endif 
    8383 

  • trunk/NEMO/OPA_SRC/OBC/obcdom.F90

    r3 r32  
    1313   USE phycst          ! physical constants 
    1414   USE obc_oce         ! ocean open boundary conditions 
     15   USE in_out_manager  ! I/O manager 
     16   USE lib_mpp         ! distributed memory computing library 
    1517 
    1618   IMPLICIT NONE 
    … …  
    154156   ! in case of zoom, icoast must be set to 0 on the domain border 
    155157   ! it must be the same for the bathymetry 
    156    IF (lzoom-w) icoast(jpiglo            ,:) = 0  
    157    IF (lzoom-e) icoast(jpiglo +jpizoom -1,:) = 0  
    158    IF (lzoom-s) icoast(:,jpjzoom           ) = 0  
    159    IF (lzoom-n) icoast(:,jpjglo+jpjzoom -1 ) = 0  
     158   IF (lzoom_w) icoast(jpiglo            ,:) = 0  
     159   IF (lzoom_e) icoast(jpiglo +jpizoom -1,:) = 0  
     160   IF (lzoom_s) icoast(:,jpjzoom           ) = 0  
     161   IF (lzoom_n) icoast(:,jpjglo+jpjzoom -1 ) = 0  
    160162 
    161163      DO jj = 1, jpjglo 
    … …  
    179181         END DO 
    180182      END DO 
    181 # if defined key_mpp  
    182       CALL mpp_sum(icheck)  
    183 # endif 
     183      IF( lk_mpp )   CALL mpp_sum(icheck)   ! sum over the global domain 
     184 
    184185      IF( icheck /= 0 ) THEN 
    185186         IF(lwp) WRITE(numout,cform_err) 

  • trunk/NEMO/OPA_SRC/OBC/obcdyn.F90

    r3 r32  
    2020   USE phycst          ! physical constants 
    2121   USE obc_oce         ! ocean open boundary conditions 
     22   USE lbclnk          ! ??? 
    2223   USE lib_mpp         ! ??? 
    2324   USE obccli          ! ocean open boundary conditions: climatology 
    … …  
    125126      END IF 
    126127 
    127 # if defined key_mpp 
    128       !!bug ??? 
    129       IF( kt >= nit000+3 .AND. ln_rstart ) THEN 
    130          CALL mpp_lnk_3d( ub, 'U', -1. ) 
    131          CALL mpp_lnk_3d( vb, 'V', -1. ) 
    132       END IF 
    133       CALL mpp_lnk_3d( ua, 'U', -1. ) 
    134       CALL mpp_lnk_3d( va, 'V', -1. ) 
    135 # endif 
     128      IF( lk_mpp ) THEN 
     129         IF( kt >= nit000+3 .AND. ln_rstart ) THEN 
     130            CALL lbc_lnk( ub, 'U', -1. ) 
     131            CALL lbc_lnk( vb, 'V', -1. ) 
     132         END IF 
     133         CALL lbc_lnk( ua, 'U', -1. ) 
     134         CALL lbc_lnk( va, 'V', -1. ) 
     135      ENDIF 
     136 
    136137   END SUBROUTINE obc_dyn 
    137138 
     139 
    138140   SUBROUTINE obc_dyn_east ( kt ) 
    139141      !!------------------------------------------------------------------------------ 
    140       !!                     SUBROUTINE obc_dyn_east 
    141       !!                    ************************* 
     142      !!                  ***  SUBROUTINE obc_dyn_east  *** 
     143      !!               
    142144      !! ** Purpose : 
    143145      !!      Apply the radiation algorithm on east OBC velocities ua, va using the  
    … …  
    157159      !! * Local declaration 
    158160      REAL(wp) ::   z05cx, ztau, zin 
    159  
    160       !!------------------------------------------------------------------------------ 
    161       !!  OPA 8.5, LODYC-IPSL (2002) 
    162161      !!------------------------------------------------------------------------------ 
    163162 
    … …  
    484483      !! * Local declaration 
    485484      REAL(wp) ::   z05cx, ztau, zin 
    486  
    487       !!------------------------------------------------------------------------------ 
    488       !!  OPA 8.5, LODYC-IPSL (2002) 
    489485      !!------------------------------------------------------------------------------ 
    490486 

  • trunk/NEMO/OPA_SRC/OBC/obcrad.F90

    r3 r32  
    7171      !!---------------------------------------------------------------------- 
    7272 
    73       ! 1. East open boundary 
    74       ! --------------------- 
    75  
    76       IF( lpeastobc .AND. ( .NOT. lfbceast ) ) THEN 
    77          CALL obc_rad_east( kt ) 
    78       END IF 
    79  
    80       ! 2. West open boundary 
    81       ! --------------------- 
    82  
    83       IF( lpwestobc .AND. ( .NOT. lfbcwest ) ) THEN 
    84          CALL obc_rad_west( kt ) 
    85       END IF 
    86  
    87       ! 3. North open boundary 
    88       ! --------------------- 
    89        
    90       IF( lpnorthobc .AND. ( .NOT. lfbcnorth ) ) THEN 
    91          CALL obc_rad_north( kt ) 
    92       END IF 
    93  
    94       ! 4. South open boundary 
    95       ! --------------------- 
    96        
    97       IF( lpsouthobc .AND. ( .NOT. lfbcsouth ) ) THEN 
    98          CALL obc_rad_south( kt ) 
    99       END IF 
     73      IF( lpeastobc  .AND. .NOT.lfbceast  )   CALL obc_rad_east ( kt )   ! East open boundary 
     74 
     75      IF( lpwestobc  .AND. .NOT.lfbcwest  )   CALL obc_rad_west ( kt )   ! West open boundary 
     76 
     77      IF( lpnorthobc .AND. .NOT.lfbcnorth )   CALL obc_rad_north( kt )   ! North open boundary 
     78 
     79      IF( lpsouthobc .AND. .NOT.lfbcsouth )   CALL obc_rad_south( kt )   ! South open boundary 
    10080 
    10181   END SUBROUTINE obc_rad 
    10282 
     83 
    10384   SUBROUTINE obc_rad_east ( kt ) 
    10485      !!------------------------------------------------------------------------------ 
    105       !!                     SUBROUTINE obc_rad_east 
    106       !!                    ************************* 
     86      !!                     ***  SUBROUTINE obc_rad_east  *** 
     87      !!                    
    10788      !! ** Purpose : 
    10889      !!      Perform swap of arrays to calculate radiative phase speeds at the open  
    … …  
    121102 
    122103      !! * Local declarations 
    123       INTEGER ::   ij, ii 
    124  
     104      INTEGER  ::   ij 
    125105      REAL(wp) ::   z05cx, zdt, z4nor2, z2dx, z2dy 
    126106      REAL(wp) ::   zucb, zucbm, zucbm2 
    127  
    128       !!------------------------------------------------------------------------------ 
    129       !!  OPA 8.5, LODYC-IPSL (2002) 
    130107      !!------------------------------------------------------------------------------ 
    131108 
    … …  
    178155            END DO 
    179156         END DO 
    180 # ifdef key_mpp 
    181          CALL mppobc(uebnd,jpjed,jpjef,jpieob,jpk*3*3,2,jpj) 
    182 # endif 
     157         IF( lk_mpp )   CALL mppobc(uebnd,jpjed,jpjef,jpieob,jpk*3*3,2,jpj) 
     158 
    183159         ! ... extremeties nie0, nie1 
    184160         ij = jpjed +1 - njmpp 
    … …  
    221197            END DO 
    222198         END DO 
    223 # ifdef key_mpp 
    224          CALL mppobc(vebnd,jpjed,jpjef,jpieob+1,jpk*3*3,2,jpj) 
    225 # endif 
     199         IF( lk_mpp )   CALL mppobc(vebnd,jpjed,jpjef,jpieob+1,jpk*3*3,2,jpj) 
     200 
    226201         !... extremeties nie0, nie1 
    227202         ij = jpjed +1 - njmpp 
    … …  
    263238            END DO 
    264239         END DO 
    265 # ifdef key_mpp 
    266          CALL mppobc(tebnd,jpjed,jpjef,jpieob+1,jpk*2*2,2,jpj) 
    267          CALL mppobc(sebnd,jpjed,jpjef,jpieob+1,jpk*2*2,2,jpj) 
    268 # endif 
     240         IF( lk_mpp )   CALL mppobc(tebnd,jpjed,jpjef,jpieob+1,jpk*2*2,2,jpj) 
     241         IF( lk_mpp )   CALL mppobc(sebnd,jpjed,jpjef,jpieob+1,jpk*2*2,2,jpj) 
     242 
    269243         ! ... extremeties nie0, nie1 
    270244         ij = jpjed +1 - njmpp 
    … …  
    365339            END DO 
    366340         END DO 
    367 # if defined key_mpp 
    368          CALL mppobc(v_cxebnd,jpjed,jpjef,jpieob+1,jpk,2,jpj) 
    369 # endif 
     341         IF( lk_mpp )   CALL mppobc(v_cxebnd,jpjed,jpjef,jpieob+1,jpk,2,jpj) 
     342 
    370343         ! ... extremeties nie0, nie1 
    371344         ij = jpjed +1 - njmpp 
    … …  
    386359   END SUBROUTINE obc_rad_east 
    387360 
     361 
    388362   SUBROUTINE obc_rad_west ( kt ) 
    389363      !!------------------------------------------------------------------------------ 
    390       !!                     SUBROUTINE obc_rad_west 
    391       !!                    ************************* 
     364      !!                  ***  SUBROUTINE obc_rad_west  *** 
     365      !!                     
    392366      !! ** Purpose : 
    393367      !!      Perform swap of arrays to calculate radiative phase speeds at the open  
    … …  
    406380 
    407381      !! * Local declarations 
    408       INTEGER ::   ij, ii 
    409  
     382      INTEGER ::   ij 
    410383      REAL(wp) ::   z05cx, zdt, z4nor2, z2dx, z2dy 
    411384      REAL(wp) ::   zucb, zucbm, zucbm2 
    412  
    413       !!------------------------------------------------------------------------------ 
    414       !!  OPA 8.5, LODYC-IPSL (2002) 
    415385      !!------------------------------------------------------------------------------ 
    416386 
    … …  
    465435            END DO 
    466436         END DO 
    467 # if defined key_mpp 
    468          CALL mppobc(uwbnd,jpjwd,jpjwf,jpiwob,jpk*3*3,2,jpj) 
    469 # endif 
     437         IF( lk_mpp )   CALL mppobc(uwbnd,jpjwd,jpjwf,jpiwob,jpk*3*3,2,jpj) 
     438 
    470439         ! ... extremeties niw0, niw1 
    471440         ij = jpjwd +1 - njmpp 
    … …  
    508477            END DO 
    509478         END DO 
    510 # if defined key_mpp 
    511          CALL mppobc(vwbnd,jpjwd,jpjwf,jpiwob,jpk*3*3,2,jpj) 
    512 # endif 
     479         IF( lk_mpp )   CALL mppobc(vwbnd,jpjwd,jpjwf,jpiwob,jpk*3*3,2,jpj) 
     480 
    513481         ! ... extremeties niw0, niw1  
    514482         ij = jpjwd +1 - njmpp  
    … …  
    550518            END DO 
    551519         END DO 
    552 # if defined key_mpp 
    553          CALL mppobc(twbnd,jpjwd,jpjwf,jpiwob,jpk*2*2,2,jpj) 
    554          CALL mppobc(swbnd,jpjwd,jpjwf,jpiwob,jpk*2*2,2,jpj) 
    555 # endif 
     520         IF( lk_mpp )   CALL mppobc(twbnd,jpjwd,jpjwf,jpiwob,jpk*2*2,2,jpj) 
     521         IF( lk_mpp )   CALL mppobc(swbnd,jpjwd,jpjwf,jpiwob,jpk*2*2,2,jpj) 
     522 
    556523         ! ... extremeties niw0, niw1 
    557524         ij = jpjwd +1 - njmpp 
    … …  
    655622            END DO 
    656623         END DO 
    657 # if defined key_mpp 
    658          CALL mppobc(v_cxwbnd,jpjwd,jpjwf,jpiwob,jpk,2,jpj) 
    659 # endif 
     624         IF( lk_mpp )   CALL mppobc(v_cxwbnd,jpjwd,jpjwf,jpiwob,jpk,2,jpj) 
     625 
    660626         ! ... extremeties niw0, niw1 
    661627         ij = jpjwd +1 - njmpp 
    … …  
    676642   END SUBROUTINE obc_rad_west 
    677643 
     644 
    678645   SUBROUTINE obc_rad_north ( kt ) 
    679646      !!------------------------------------------------------------------------------ 
    680       !!                     SUBROUTINE obc_rad_north 
    681       !!                    ************************* 
     647      !!                  ***  SUBROUTINE obc_rad_north  *** 
     648      !!            
    682649      !! ** Purpose : 
    683650      !!      Perform swap of arrays to calculate radiative phase speeds at the open  
    … …  
    696663 
    697664      !! * Local declarations 
    698       INTEGER ::   ij, ii 
    699  
     665      INTEGER  ::   ii 
    700666      REAL(wp) ::   z05cx, zdt, z4nor2, z2dx, z2dy 
    701667      REAL(wp) ::   zvcb, zvcbm, zvcbm2 
    702  
    703       !!------------------------------------------------------------------------------ 
    704       !!  OPA 8.5, LODYC-IPSL (2002) 
    705668      !!------------------------------------------------------------------------------ 
    706669 
    … …  
    736699            END DO 
    737700         END DO 
    738 # if defined key_mpp 
    739          CALL mppobc(unbnd,jpind,jpinf,jpjnob+1,jpk*3*3,1,jpi) 
    740 # endif 
     701         IF( lk_mpp )   CALL mppobc(unbnd,jpind,jpinf,jpjnob+1,jpk*3*3,1,jpi) 
     702 
    741703         ! ... extremeties njn0,njn1  
    742704         ii = jpind + 1 - nimpp  
    … …  
    798760            END DO 
    799761         END DO 
    800 # if defined key_mpp 
    801          CALL mppobc(vnbnd,jpind,jpinf,jpjnob,jpk*3*3,1,jpi) 
    802 # endif 
     762         IF( lk_mpp )   CALL mppobc(vnbnd,jpind,jpinf,jpjnob,jpk*3*3,1,jpi) 
     763 
    803764         ! ... extremeties njn0,njn1 
    804765         ii = jpind + 1 - nimpp 
    … …  
    840801            END DO 
    841802         END DO 
    842 # if defined key_mpp 
    843          CALL mppobc(tnbnd,jpind,jpinf,jpjnob+1,jpk*2*2,1,jpi) 
    844          CALL mppobc(snbnd,jpind,jpinf,jpjnob+1,jpk*2*2,1,jpi) 
    845 # endif 
     803         IF( lk_mpp )   CALL mppobc(tnbnd,jpind,jpinf,jpjnob+1,jpk*2*2,1,jpi) 
     804         IF( lk_mpp )   CALL mppobc(snbnd,jpind,jpinf,jpjnob+1,jpk*2*2,1,jpi) 
     805 
    846806         ! ... extremeties  njn0,njn1 
    847807         ii = jpind + 1 - nimpp 
    … …  
    908868            END DO 
    909869         END DO 
    910 # if defined key_mpp 
    911          CALL mppobc(u_cynbnd,jpind,jpinf,jpjnob+1,jpk,1,jpi) 
    912 # endif 
     870         IF( lk_mpp )   CALL mppobc(u_cynbnd,jpind,jpinf,jpjnob+1,jpk,1,jpi) 
     871 
    913872         ! ... extremeties  njn0,njn1 
    914873         ii = jpind + 1 - nimpp 
    … …  
    973932   END SUBROUTINE obc_rad_north 
    974933 
     934 
    975935   SUBROUTINE obc_rad_south ( kt ) 
    976936      !!------------------------------------------------------------------------------ 
    977       !!                     SUBROUTINE obc_rad_south 
    978       !!                    ************************* 
     937      !!                  ***  SUBROUTINE obc_rad_south  *** 
     938      !!            
    979939      !! ** Purpose : 
    980940      !!      Perform swap of arrays to calculate radiative phase speeds at the open  
    … …  
    993953 
    994954      !! * Local declarations 
    995       INTEGER ::   ij, ii 
    996  
     955      INTEGER ::   ii 
    997956      REAL(wp) ::   z05cx, zdt, z4nor2, z2dx, z2dy 
    998957      REAL(wp) ::   zvcb, zvcbm, zvcbm2 
    999  
    1000       !!------------------------------------------------------------------------------ 
    1001       !!  OPA 8.5, LODYC-IPSL (2002) 
    1002958      !!------------------------------------------------------------------------------ 
    1003959 
    … …  
    1033989            END DO 
    1034990         END DO 
    1035 # if defined key_mpp 
    1036          CALL mppobc(usbnd,jpisd,jpisf,jpjsob,jpk*3*3,1,jpi) 
    1037 # endif 
     991         IF( lk_mpp )   CALL mppobc(usbnd,jpisd,jpisf,jpjsob,jpk*3*3,1,jpi) 
     992 
    1038993         ! ... extremeties njs0,njs1 
    1039994         ii = jpisd + 1 - nimpp 
    … …  
    10931048            END DO 
    10941049         END DO 
    1095 # if defined key_mpp 
    1096          CALL mppobc(vsbnd,jpisd,jpisf,jpjsob,jpk*3*3,1,jpi) 
    1097 # endif 
     1050         IF( lk_mpp )   CALL mppobc(vsbnd,jpisd,jpisf,jpjsob,jpk*3*3,1,jpi) 
     1051 
    10981052         ! ... extremeties njs0,njs1 
    10991053         ii = jpisd + 1 - nimpp 
    … …  
    11351089            END DO 
    11361090         END DO 
    1137 # if defined key_mpp 
    1138          CALL mppobc(tsbnd,jpisd,jpisf,jpjsob,jpk*2*2,1,jpi) 
    1139          CALL mppobc(ssbnd,jpisd,jpisf,jpjsob,jpk*2*2,1,jpi) 
    1140 # endif  
     1091         IF( lk_mpp )   CALL mppobc(tsbnd,jpisd,jpisf,jpjsob,jpk*2*2,1,jpi) 
     1092         IF( lk_mpp )   CALL mppobc(ssbnd,jpisd,jpisf,jpjsob,jpk*2*2,1,jpi) 
     1093 
    11411094         ! ... extremeties  njs0,njs1 
    11421095         ii = jpisd + 1 - nimpp 
    … …  
    12031156            END DO 
    12041157         END DO 
    1205 # if defined key_mpp 
    1206          CALL mppobc(u_cysbnd,jpisd,jpisf,jpjsob,jpk,1,jpi) 
    1207 # endif 
     1158         IF( lk_mpp )   CALL mppobc(u_cysbnd,jpisd,jpisf,jpjsob,jpk,1,jpi) 
     1159 
    12081160         ! ... extremeties  njs0,njs1 
    12091161         ii = jpisd + 1 - nimpp 
    … …  
    12631215         END DO 
    12641216 
    1265       END IF 
     1217      ENDIF 
    12661218  
    12671219   END SUBROUTINE obc_rad_south 
     1220 
    12681221#else 
    12691222   !!================================================================================= 
    … …  
    12741227   SUBROUTINE obc_rad( kt )            ! No open boundaries ==> empty routine 
    12751228      INTEGER, INTENT(in) :: kt 
    1276       WRITE(*,*) kt 
     1229      WRITE(*,*) 'obc_rad: You should not have seen this print! error?', kt 
    12771230   END SUBROUTINE obc_rad 
    12781231#endif 

  • trunk/NEMO/OPA_SRC/OBC/obcrst.F90

    r3 r32  
    2525 
    2626   !!--------------------------------------------------------------------------------- 
     27   !!   OPA 9.0 , LODYC-IPSL   (2003) 
     28   !!--------------------------------------------------------------------------------- 
    2729 
    2830CONTAINS 
    … …  
    3032   SUBROUTINE obc_rst_wri ( kt ) 
    3133      !!-------------------------------------------------------------------------------- 
    32       !!                     SUBROUTINE obc_rst_wri 
    33       !!                    ************************ 
    34       !! ** Purpose : 
    35       !!      Write restart fields in numwob for open boundaries 
     34      !!                  ***  SUBROUTINE obc_rst_wri  *** 
     35      !!                 
     36      !! ** Purpose :   Write open boundary restart fields in restart.obc.output file  
    3637      !! 
    37       !! ** Method : 
    38       !!      numwob file: Direct access non formatted file. 
     38      !! ** Method  :   restart.obc.output file: Direct access non formatted file. 
    3939      !!      Each nstock time step , save fields which are necessary for restart. 
    4040      !!      - This routine is called if at least the key_obc is defined. It is called 
    … …  
    5858      !!   8.5   ! 02-10 (C. Talandier, A-M. Treguier) F90 
    5959      !!         ! 03-06 (J.M. Molines) Bug fix for adjacent processors 
     60      !!   9.0   ! 04-02 (G. Madec)  suppression of numwob, use inum 
    6061      !!----------------------------------------------------------------------------------- 
    6162      !! * Arguments 
    … …  
    6465      !! * Local declarations 
    6566      INTEGER ::   ji, jj, jk, ios 
     67      INTEGER ::   inum = 11          ! temporary logical unit 
    6668      INTEGER ::   ibloc, nreclo, jrec, jt, jb  
    6769      INTEGER ::   jfoe, jfow, ifon, ifos 
    6870      INTEGER ::   ino0, it0 
    6971      !!----------------------------------------------------------------------------- 
    70       !!   OPA 8.5, LODYC-IPSL (2002) 
    71       !!----------------------------------------------------------------------------- 
    72  
    73       ! 1. Output of restart fields (numwob) 
     72 
     73      ! 1. Output of restart fields (inum) 
    7474      ! ------------------------------------ 
    7575  
    … …  
    8282              WRITE(numout,*) 'obcrst: OBC output for restart with obc_rst_wri routine' 
    8383              WRITE(numout,*) '~~~~~~' 
    84               WRITE(numout,*) '        output done in numwob = ', numwob,' at it= ',kt, &  
    85                               ' date= ',ndastp 
     84              WRITE(numout,*) '        output done in restart.obc.output file at it= ', kt, ' date= ', ndastp 
    8685         END IF 
    8786 
    … …  
    9594         ! 1.1 Open file 
    9695         ! ------------- 
    97          OPEN( UNIT   =  numwob,              & 
     96         OPEN( UNIT   = inum,                 & 
    9897               IOSTAT = ios,                  & 
    9998               FILE   = 'restart.obc.output', & 
    … …  
    110109         ! 1.2 Write header 
    111110         ! ---------------- 
    112          WRITE (numwob,REC=1) ino0,it0,nbobc,jpieob,jpiwob,jpjnob,jpjsob,     & 
     111         WRITE (inum,REC=1) ino0,it0,nbobc,jpieob,jpiwob,jpjnob,jpjsob,     & 
    113112                              jpjed,jpjef,jpjwd,jpjwf,jpind,jpinf,jpisd,jpisf 
    114113 
    … …  
    128127                     jfoe = jpjed - njmpp + 1 
    129128                     PRINT *,'Narea =',narea,' write jrec =2 east' 
    130                      WRITE(numwob,REC=jrec)                                    & 
     129                     WRITE(inum,REC=jrec)                                    & 
    131130# if ! defined key_dynspg_fsc 
    132131                           ((  bebnd(jfoe,   jb,jt),          jb=1,3),jt=1,3), & 
    … …  
    143142                        jfoe = jj  
    144143                        jrec = 2 + jj + njmpp -1 -jpjed 
    145                         WRITE (numwob,REC=jrec)                                   & 
     144                        WRITE (inum,REC=jrec)                                   & 
    146145# if ! defined key_dynspg_fsc 
    147146                              ((  bebnd(jfoe,   jb,jt),          jb=1,3),jt=1,3), & 
    … …  
    173172                     jfow = jpjwd -njmpp + 1 
    174173                     PRINT *,'Narea =',narea,' write jrec =',jrec,' west' 
    175                      WRITE (numwob,REC=jrec)                                   & 
     174                     WRITE (inum,REC=jrec)                                   & 
    176175# if ! defined key_dynspg_fsc 
    177176                           ((  bwbnd(jfow,   jb,jt),          jb=1,3),jt=1,3), & 
    … …  
    188187                        jfow = jj  
    189188                        jrec = 3 + jpjef -jpjed + jj + njmpp -1 -jpjwd 
    190                         WRITE (numwob,REC=jrec)                                   & 
     189                        WRITE (inum,REC=jrec)                                   & 
    191190# if ! defined key_dynspg_fsc 
    192191                              ((  bwbnd(jfow,   jb,jt),          jb=1,3),jt=1,3), & 
    … …  
    217216            !        ifon = jpind 
    218217                     ifon = jpind -nimpp +1 
    219                      WRITE (numwob,REC=jrec)                                   & 
     218                     WRITE (inum,REC=jrec)                                   & 
    220219# if ! defined key_dynspg_fsc 
    221220                           ((  bnbnd(ifon,   jb,jt),          jb=1,3),jt=1,3), & 
    … …  
    232231                        ifon = ji  
    233232                        jrec = 4 + jpjef -jpjed + jpjwf -jpjwd +ji + nimpp -1  -jpind 
    234                         WRITE (numwob,REC=jrec)                                   & 
     233                        WRITE (inum,REC=jrec)                                   & 
    235234# if ! defined key_dynspg_fsc 
    236235                              ((  bnbnd(ifon,   jb,jt),          jb=1,3),jt=1,3), & 
    … …  
    262261            !        ifos = jpisd 
    263262                     ifos = jpisd -nimpp + 1 
    264                      WRITE (numwob,REC=jrec)                                   & 
     263                     WRITE (inum,REC=jrec)                                   & 
    265264# if ! defined key_dynspg_fsc 
    266265                           ((  bsbnd(ifos,   jb,jt),          jb=1,3),jt=1,3), & 
    … …  
    278277                        jrec = 5 + jpjef -jpjed + jpjwf -jpjwd +jpinf -jpind + & 
    279278                              ji + nimpp -1 -jpisd 
    280                         WRITE (numwob,REC=jrec) & 
     279                        WRITE (inum,REC=jrec) & 
    281280# if ! defined key_dynspg_fsc 
    282281                              ((  bsbnd(ifos,   jb,jt),          jb=1,3),jt=1,3), & 
    … …  
    292291         END IF 
    293292      END IF 
    294       CLOSE(numwob) 
     293      CLOSE(inum) 
    295294 
    296295   END SUBROUTINE obc_rst_wri 
     296 
    297297 
    298298   SUBROUTINE obc_rst_lec 
    299299      !!---------------------------------------------------------------------------- 
    300       !!                      SUBROUTINE obc_rst_lec 
    301       !!                     ************************ 
    302       !! ** Purpose : 
    303       !!      Read files for restart at open boundaries 
     300      !!                   ***  SUBROUTINE obc_rst_lec  *** 
     301      !!                    
     302      !! ** Purpose :   Read files for restart at open boundaries 
    304303      !! 
    305       !! ** Method : 
    306       !!      Read the previous boundary arrays on unit numrob 
     304      !! ** Method  :   Read the previous boundary arrays on unit inum 
    307305      !!      The first record indicates previous characterics 
    308306      !! 
    … …  
    312310      !!---------------------------------------------------------------------------- 
    313311      !! * Local declarations 
     312      INTEGER ::   inum = 11            ! temporary logical unit 
    314313      INTEGER ::   ji,jj,jk,ios 
    315314      INTEGER ::   ino0,it0,nbobc0,jpieob0,jpiwob0,jpjnob0,jpjsob0 
    … …  
    320319      INTEGER ::   jfoe, jfow, ifon, ifos 
    321320      !!----------------------------------------------------------------------------- 
    322       !!   OPA 8.5, LODYC-IPSL (2002) 
    323       !!----------------------------------------------------------------------------- 
    324321 
    325322      ! 0. Initialisations 
    … …  
    358355      ! 0.1 Open files 
    359356      ! --------------- 
    360       OPEN( UNIT   =  numrob,       & 
     357      OPEN( UNIT   =  inum,       & 
    361358            IOSTAT =  ios,          & 
    362359            FILE   = 'restart.obc', & 
    … …  
    374371      ! 1.1 First record 
    375372      ! ----------------- 
    376       READ(numrob,REC=1) ino1,it1,nbobc1,jpieob1,jpiwob1,jpjnob1,     & 
     373      READ(inum,REC=1) ino1,it1,nbobc1,jpieob1,jpiwob1,jpjnob1,     & 
    377374                         jpjsob1,ied1,ief1,iwd1,iwf1,ind1,inf1,isd1,isf1 
    378375  
    379376      IF(lwp) THEN 
    380377         WRITE(numout,*) ' ' 
    381          WRITE(numout,*) '        READ numrob with number job : ',ino1,' with the time it: ',it1 
     378         WRITE(numout,*) '        READ inum with number job : ',ino1,' with the time it: ',it1 
    382379         WRITE(numout,*) ' ' 
    383380      END IF 
    … …  
    520517      !        jfoe = jpjed 
    521518               jfoe = jpjed -njmpp + 1 
    522                READ (numrob,REC=jrec)                                   & 
     519               READ (inum,REC=jrec)                                   & 
    523520# if ! defined key_dynspg_fsc 
    524521                    ((  bebnd(jfoe,   jb,jt),          jb=1,3),jt=1,3), & 
    … …  
    535532                  jfoe = jj  
    536533                  jrec = 2 + jj + njmpp -1 -jpjed 
    537                   READ (numrob,REC=jrec)                                   & 
     534                  READ (inum,REC=jrec)                                   & 
    538535# if ! defined key_dynspg_fsc 
    539536                       ((  bebnd(jfoe,   jb,jt),          jb=1,3),jt=1,3), & 
    … …  
    562559      !        jfow = jpjwd 
    563560               jfow = jpjwd -njmpp + 1 
    564                READ (numrob,REC=jrec)                                   & 
     561               READ (inum,REC=jrec)                                   & 
    565562# if ! defined key_dynspg_fsc 
    566563                    ((  bwbnd(jfow,   jb,jt),          jb=1,3),jt=1,3), & 
    … …  
    577574                  jfow = jj  
    578575                  jrec = 3 + jpjef -jpjed + jj + njmpp -1 -jpjwd 
    579                   READ (numrob,REC=jrec)                                   & 
     576                  READ (inum,REC=jrec)                                   & 
    580577# if ! defined key_dynspg_fsc 
    581578                       ((  bwbnd(jfow,   jb,jt),          jb=1,3),jt=1,3), & 
    … …  
    604601      !        ifon = jpind 
    605602               ifon = jpind -nimpp +1 
    606                READ (numrob,REC=jrec)                                   & 
     603               READ (inum,REC=jrec)                                   & 
    607604# if ! defined key_dynspg_fsc 
    608605                    ((  bnbnd(ifon,   jb,jt),          jb=1,3),jt=1,3), & 
    … …  
    619616                  ifon = ji  
    620617                  jrec = 4 + jpjef -jpjed + jpjwf -jpjwd +ji + nimpp -1  -jpind 
    621                   READ (numrob,REC=jrec)                                   &  
     618                  READ (inum,REC=jrec)                                   &  
    622619# if ! defined key_dynspg_fsc 
    623620                       ((  bnbnd(ifon,   jb,jt),          jb=1,3),jt=1,3), & 
    … …  
    646643      !        ifos = jpisd 
    647644               ifos = jpisd -nimpp + 1 
    648                READ (numrob,REC=jrec)                                   & 
     645               READ (inum,REC=jrec)                                   & 
    649646# if ! defined key_dynspg_fsc 
    650647                    ((  bsbnd(ifos,   jb,jt),          jb=1,3),jt=1,3), & 
    … …  
    662659                  jrec = 5 + jpjef -jpjed + jpjwf -jpjwd +jpinf -jpind +  & 
    663660                        ji + nimpp -1 -jpisd 
    664                   READ (numrob,REC=jrec)                                   &  
     661                  READ (inum,REC=jrec)                                   &  
    665662# if ! defined key_dynspg_fsc 
    666663                       ((  bsbnd(ifos,   jb,jt),          jb=1,3),jt=1,3), & 
    … …  
    677674 
    678675      END IF 
    679       CLOSE(numrob) 
    680  
    681 # if defined key_mpp 
    682       IF( lpeastobc ) THEN 
    683          CALL mppobc(bebnd,jpjed,jpjef,jpieob,3*3,2,jpj) 
    684          CALL mppobc(uebnd,jpjed,jpjef,jpieob,jpk*3*3,2,jpj) 
    685          CALL mppobc(vebnd,jpjed,jpjef,jpieob+1,jpk*3*3,2,jpj) 
    686          CALL mppobc(tebnd,jpjed,jpjef,jpieob+1,jpk*2*2,2,jpj) 
    687          CALL mppobc(sebnd,jpjed,jpjef,jpieob+1,jpk*2*2,2,jpj) 
    688       END IF 
    689       IF( lpwestobc ) THEN 
    690          CALL mppobc(bwbnd,jpjwd,jpjwf,jpiwob,3*3,2,jpj) 
    691          CALL mppobc(uwbnd,jpjwd,jpjwf,jpiwob,jpk*3*3,2,jpj) 
    692          CALL mppobc(vwbnd,jpjwd,jpjwf,jpiwob,jpk*3*3,2,jpj) 
    693          CALL mppobc(twbnd,jpjwd,jpjwf,jpiwob,jpk*2*2,2,jpj) 
    694          CALL mppobc(swbnd,jpjwd,jpjwf,jpiwob,jpk*2*2,2,jpj) 
    695       END IF 
    696       IF( lpnorthobc ) THEN  
    697          CALL mppobc(bnbnd,jpind,jpinf,jpjnob  ,3*3    ,1,jpi) 
    698          CALL mppobc(unbnd,jpind,jpinf,jpjnob+1,jpk*3*3,1,jpi) 
    699          CALL mppobc(vnbnd,jpind,jpinf,jpjnob  ,jpk*3*3,1,jpi) 
    700          CALL mppobc(tnbnd,jpind,jpinf,jpjnob+1,jpk*2*2,1,jpi) 
    701          CALL mppobc(snbnd,jpind,jpinf,jpjnob+1,jpk*2*2,1,jpi) 
    702       END IF 
    703       IF( lpsouthobc ) THEN 
    704          CALL mppobc(bsbnd,jpisd,jpisf,jpjsob,    3*3,1,jpi) 
    705          CALL mppobc(usbnd,jpisd,jpisf,jpjsob,jpk*3*3,1,jpi) 
    706          CALL mppobc(vsbnd,jpisd,jpisf,jpjsob,jpk*3*3,1,jpi) 
    707          CALL mppobc(tsbnd,jpisd,jpisf,jpjsob,jpk*2*2,1,jpi) 
    708          CALL mppobc(ssbnd,jpisd,jpisf,jpjsob,jpk*2*2,1,jpi) 
    709       END IF 
    710 # endif 
     676      CLOSE(inum) 
     677 
     678      IF( lk_mpp ) THEN 
     679         IF( lpeastobc ) THEN 
     680# if ! defined key_dynspg_fsc 
     681            CALL mppobc(bebnd,jpjed,jpjef,jpieob,3*3,2,jpj) 
     682# endif 
     683            CALL mppobc(uebnd,jpjed,jpjef,jpieob,jpk*3*3,2,jpj) 
     684            CALL mppobc(vebnd,jpjed,jpjef,jpieob+1,jpk*3*3,2,jpj) 
     685            CALL mppobc(tebnd,jpjed,jpjef,jpieob+1,jpk*2*2,2,jpj) 
     686            CALL mppobc(sebnd,jpjed,jpjef,jpieob+1,jpk*2*2,2,jpj) 
     687         ENDIF 
     688         IF( lpwestobc ) THEN 
     689# if ! defined key_dynspg_fsc 
     690            CALL mppobc(bwbnd,jpjwd,jpjwf,jpiwob,3*3,2,jpj) 
     691# endif 
     692            CALL mppobc(uwbnd,jpjwd,jpjwf,jpiwob,jpk*3*3,2,jpj) 
     693            CALL mppobc(vwbnd,jpjwd,jpjwf,jpiwob,jpk*3*3,2,jpj) 
     694            CALL mppobc(twbnd,jpjwd,jpjwf,jpiwob,jpk*2*2,2,jpj) 
     695            CALL mppobc(swbnd,jpjwd,jpjwf,jpiwob,jpk*2*2,2,jpj) 
     696         ENDIF 
     697         IF( lpnorthobc ) THEN  
     698# if ! defined key_dynspg_fsc 
     699            CALL mppobc(bnbnd,jpind,jpinf,jpjnob  ,3*3    ,1,jpi) 
     700# endif 
     701            CALL mppobc(unbnd,jpind,jpinf,jpjnob+1,jpk*3*3,1,jpi) 
     702            CALL mppobc(vnbnd,jpind,jpinf,jpjnob  ,jpk*3*3,1,jpi) 
     703            CALL mppobc(tnbnd,jpind,jpinf,jpjnob+1,jpk*2*2,1,jpi) 
     704            CALL mppobc(snbnd,jpind,jpinf,jpjnob+1,jpk*2*2,1,jpi) 
     705         ENDIF 
     706         IF( lpsouthobc ) THEN 
     707# if ! defined key_dynspg_fsc 
     708            CALL mppobc(bsbnd,jpisd,jpisf,jpjsob,    3*3,1,jpi) 
     709# endif 
     710            CALL mppobc(usbnd,jpisd,jpisf,jpjsob,jpk*3*3,1,jpi) 
     711            CALL mppobc(vsbnd,jpisd,jpisf,jpjsob,jpk*3*3,1,jpi) 
     712            CALL mppobc(tsbnd,jpisd,jpisf,jpjsob,jpk*2*2,1,jpi) 
     713            CALL mppobc(ssbnd,jpisd,jpisf,jpjsob,jpk*2*2,1,jpi) 
     714         ENDIF 
     715      ENDIF 
    711716  
    712717   END SUBROUTINE obc_rst_lec 
    … …  
    719724   SUBROUTINE obc_rst_wri( kt )           !  No Open boundary ==> empty routine 
    720725      INTEGER,INTENT(in) :: kt 
    721       WRITE(*,*) kt 
     726      WRITE(*,*) 'obc_rst_wri: You should not have seen this print! error?', kt 
    722727   END SUBROUTINE obc_rst_wri 
    723728   SUBROUTINE obc_rst_lec                 !  No Open boundary ==> empty routine 

  • trunk/NEMO/OPA_SRC/OBC/obcspg.F90

    r3 r32  
    55   !!                      open boundary 
    66   !!====================================================================== 
    7 #if defined key_obc && defined key_dynspg_rl 
     7#if   defined key_obc   &&  defined key_dynspg_rl 
    88   !!---------------------------------------------------------------------- 
    99   !!   'key_obc'    and                            Open Boundary Condition 
    … …  
    8686      !!---------------------------------------------------------------------- 
    8787 
    88       ! 0. Local constant initialization 
    89       ! -------------------------------- 
    90  
    91       IF( kt == nit000 .OR. ln_rstart ) THEN 
     88      IF( kt == nit000 .OR. ln_rstart ) THEN      ! Initialization 
    9289         ! ... Boundary restoring coefficient 
    9390         rtaue = 2. * rdt / rdpeob 
    … …  
    10097         rtaunin = 2. * rdt / rdpnin 
    10198         rtausin = 2. * rdt / rdpsin  
    102       END IF 
    103  
    104       ! ... right hand side of the barotropic elliptic equation 
     99      ENDIF 
     100 
     101      ! right hand side of the barotropic elliptic equation 
     102      ! --------------------------------------------------- 
     103 
     104      ! Isolated coastline contribution to the RHS of the barotropic Eq. 
    105105      gcbob(:,:) = 0.e0 
    106  
    107       ! 1. Isolated coastline contribution to the RHS of the barotropic Eq. 
    108       ! ------------------------------------------------------------------- 
    109106      DO jnic = 1, nbobc-1 
    110          DO jj = 1, jpj 
    111             DO ji = 1, jpi 
    112                gcbob(ji,jj) = gcbob(ji,jj) + gcfobc(ji,jj,jnic) * gcbic(jnic) 
    113             END DO 
    114          END DO 
     107         gcbob(:,:) = gcbob(:,:) + gcfobc(:,:,jnic) * gcbic(jnic) 
    115108      END DO 
    116109 
    117       ! 2. East open boundary 
    118       ! --------------------- 
    119  
    120       IF( lpeastobc ) THEN 
    121          CALL obc_spg_east( kt ) 
    122       END IF 
    123  
    124       ! 3. West open boundary 
    125       ! --------------------- 
    126  
    127       IF( lpwestobc ) THEN 
    128          CALL obc_spg_west( kt ) 
    129       END IF 
    130          
    131       ! 4. North open boundary 
    132       ! ---------------------- 
    133  
    134       IF( lpnorthobc ) THEN 
    135          CALL obc_spg_north( kt ) 
    136       END IF 
    137   
    138       ! 5. South open boundary 
    139       ! ---------------------- 
    140  
    141       IF( lpsouthobc ) THEN 
    142          CALL obc_spg_south( kt ) 
    143       END IF 
    144   
    145 # if defined key_mpp 
    146       CALL mpp_lnk_2d( gcbob, 'G', 1. ) 
    147 # endif 
     110      IF( lpeastobc  )   CALL obc_spg_east ( kt )    ! East open boundary 
     111 
     112      IF( lpwestobc  )   CALL obc_spg_west ( kt )    ! West open boundary 
     113 
     114      IF( lpnorthobc )   CALL obc_spg_north( kt )    ! North open boundary 
     115 
     116      IF( lpsouthobc )   CALL obc_spg_south( kt )    ! South open boundary 
     117 
     118      IF( lk_mpp )   CALL lbc_lnk( gcbob, 'G', 1. ) 
    148119  
    149120   END SUBROUTINE obc_spg 
    150121 
     122 
    151123   SUBROUTINE obc_spg_east ( kt ) 
    152124      !!------------------------------------------------------------------------------ 
    153       !!                     SUBROUTINE obc_spg_east 
    154       !!                    ************************* 
    155       !! ** Purpose : 
    156       !!      Apply the radiation algorithm on east OBC stream function. 
    157       !!      If the logical lfbceast is .TRUE., there is no radiation but only fixed OBC 
     125      !!                ***  SUBROUTINE obc_spg_east  *** 
     126      !!                  
     127      !! ** Purpose :   Apply the radiation algorithm on east OBC stream function. 
     128      !!      If lfbceast=T , there is no radiation but only fixed OBC 
    158129      !! 
    159130      !!  History : 
    … …  
    169140      !! * Local declarations 
    170141      INTEGER ::   ij 
    171  
    172142      REAL(wp) ::   z2dtr, ztau, zin 
    173143      REAL(wp) ::   z05cx, zdt, z4nor2, z2dx, z2dy 
    174  
    175       !!------------------------------------------------------------------------------ 
    176       !!  OPA 8.5, LODYC-IPSL (2002) 
    177144      !!------------------------------------------------------------------------------ 
    178145 
    … …  
    229196                  IF(lwp) WRITE(numout,*)' PB dans obc_spg_east au pt ',jj,' : z4nor=0' 
    230197                  z4nor2 = 0.001 
    231                END IF 
     198               ENDIF 
    232199               z05cx = zdt * z2dx / z4nor2 * bmask(ji,jj) 
    233200               z05cx = z05cx / e1v(ji+1,jj) 
    … …  
    249216         END DO 
    250217 
    251       END IF 
    252 # if defined key_mpp 
    253       CALL mppobc(bsfeob,jpjed,jpjef,jpieob-1,1,2,jpj) 
    254 # endif 
     218      ENDIF 
     219      IF( lk_mpp )   CALL mppobc(bsfeob,jpjed,jpjef,jpieob-1,1,2,jpj) 
     220 
    255221 
    256222      ! 3. right hand side of the barotropic elliptic equation 
    … …  
    258224  
    259225      IF( ( neuler == 0 ) .AND. ( kt == nit000 ) ) THEN 
    260          z2dtr=1./rdt 
     226         z2dtr = 1.0 / rdt 
    261227      ELSE 
    262          z2dtr=1./2./rdt 
    263       END IF 
     228         z2dtr = 0.5 / rdt 
     229      ENDIF 
    264230      DO ji = fs_nie0-1, fs_nie1-1 ! Vector opt. 
    265231         DO jj = nje0m1, nje1  
    … …  
    351317                  IF(lwp) WRITE(numout,*)' PB dans obc_spg_west au pt ',jj,' : z4nor =0' 
    352318                  z4nor2=0.0001 
    353                END IF 
     319               ENDIF 
    354320               z05cx = zdt * z2dx / z4nor2 * bmask(ji,jj) 
    355321               z05cx = z05cx / e1v(ji,jj) 
    … …  
    368334         END DO 
    369335 
    370       END IF 
    371 # if defined key_mpp  
    372       CALL mppobc(bsfwob,jpjwd,jpjwf,jpiwob+1,1,2,jpj)  
    373 # endif  
     336      ENDIF 
     337      IF( lk_mpp )   CALL mppobc(bsfwob,jpjwd,jpjwf,jpiwob+1,1,2,jpj)  
     338 
    374339 
    375340      ! 3. right hand side of the barotropic elliptic equation 
    … …  
    377342 
    378343      IF( ( neuler == 0 ) .AND. ( kt == nit000 ) ) THEN 
    379          z2dtr=1./rdt 
     344         z2dtr = 1.0 / rdt 
    380345      ELSE 
    381          z2dtr=1./2./rdt 
    382       END IF 
     346         z2dtr = 0.5 / rdt 
     347      ENDIF 
    383348      DO ji = fs_niw0+1, fs_niw1+1 ! Vector opt. 
    384349         DO jj = njw0m1, njw1 
    … …  
    392357   SUBROUTINE obc_spg_north ( kt ) 
    393358      !!------------------------------------------------------------------------------ 
    394       !!                     SUBROUTINE obc_spg_north 
    395       !!                    ************************* 
    396       !! ** Purpose : 
    397       !!      Apply the radiation algorithm on north OBC stream function. 
    398       !!      If the logical lfbcnorth is .TRUE., there is no radiation but only fixed OBC 
     359      !!                 ***  SUBROUTINE obc_spg_north  *** 
     360      !!  
     361      !! ** Purpose :   Apply the radiation algorithm on north OBC stream function. 
     362      !!      If lfbcnorth=T, there is no radiation but only fixed OBC 
    399363      !! 
    400364      !!  History : 
    … …  
    410374      !! * Local declarations 
    411375      INTEGER ::   ii 
    412  
    413376      REAL(wp) ::   z2dtr, ztau, zin 
    414377      REAL(wp) ::   z05cx, zdt, z4nor2, z2dx, z2dy 
    415  
    416       !!------------------------------------------------------------------------------ 
    417       !!  OPA 8.5, LODYC-IPSL (2002) 
    418378      !!------------------------------------------------------------------------------ 
    419379 
    … …  
    475435               IF( z4nor2 == 0 ) THEN 
    476436                  IF(lwp) WRITE(numout,*)' PB dans obc_spg_north au pt',ji,' : z4nor =0' 
    477                END IF 
     437               ENDIF 
    478438               z05cx = zdt * z2dx / z4nor2 * bmask(ji,jj) 
    479439               z05cx = z05cx / e2u(ji,jj+1) 
    … …  
    492452         END DO 
    493453 
    494       END IF 
    495 # if defined key_mpp 
    496       call mppobc(bsfnob,jpind,jpinf,jpjnob-1,1,1,jpi) 
    497 # endif 
     454      ENDIF 
     455      IF( lk_mpp )   CALL mppobc(bsfnob,jpind,jpinf,jpjnob-1,1,1,jpi) 
     456 
    498457 
    499458      ! 3. right hand side of the barotropic elliptic equation 
    … …  
    501460 
    502461      IF( ( neuler == 0 ) .AND. ( kt == nit000 ) ) THEN 
    503          z2dtr=1./rdt 
     462         z2dtr = 1.0 / rdt 
    504463      ELSE 
    505          z2dtr=1./2./rdt 
    506       END IF 
     464         z2dtr = 0.5 / rdt 
     465      ENDIF 
    507466      DO jj = fs_njn0-1, fs_njn1-1 ! Vector opt. 
    508467         DO ji = nin0m1, nin1 
    … …  
    514473   END SUBROUTINE obc_spg_north 
    515474 
     475 
    516476   SUBROUTINE obc_spg_south ( kt ) 
    517477      !!------------------------------------------------------------------------------ 
    518       !!                     SUBROUTINE obc_spg_south 
    519       !!                    ************************* 
    520       !! ** Purpose : 
    521       !!      Apply the radiation algorithm on south OBC stream function. 
    522       !!      If the logical lfbcsouth is .TRUE., there is no radiation but only fixed OBC 
     478      !!                  ***  SUBROUTINE obc_spg_south  *** 
     479      !!                 
     480      !! ** Purpose :   Apply the radiation algorithm on south OBC stream function. 
     481      !!      If lfbcsouth=T, there is no radiation but only fixed OBC 
    523482      !! 
    524483      !!  History : 
    … …  
    596555               IF( z4nor2 == 0 ) THEN 
    597556                  IF(lwp) WRITE(numout,*)' PB dans obc_spg_south au pt ',ji,' : z4nor =0' 
    598                END IF 
     557               ENDIF 
    599558               z05cx = zdt * z2dx / z4nor2 * bmask(ji,jj) 
    600559               z05cx = z05cx / e2u(ji,jj) 
    … …  
    613572         END DO 
    614573 
    615       END IF 
    616 # if defined key_mpp 
    617       CALL mppobc(bsfsob,jpisd,jpisf,jpjsob+1,1,1,jpi) 
    618 # endif 
     574      ENDIF 
     575      IF( lk_mpp )   CALL mppobc(bsfsob,jpisd,jpisf,jpjsob+1,1,1,jpi) 
     576 
    619577  
    620578      ! 3. right hand side of the barotropic elliptic equation 
    621579      ! ------------------------------------------------------- 
    622580 
    623       IF( ( neuler == 0 ) .and. ( kt == nit000 ) ) THEN 
    624          z2dtr=1./rdt 
     581      IF( ( neuler == 0 ) .AND. ( kt == nit000 ) ) THEN 
     582         z2dtr = 1.0 / rdt 
    625583      ELSE 
    626          z2dtr=1./2./rdt 
    627       END IF 
     584         z2dtr = 0.5 / rdt 
     585      ENDIF 
    628586      DO jj = fs_njs0+1, fs_njs1+1 ! Vector opt. 
    629587         DO ji = nis0m1, nis1  
    … …  
    642600   SUBROUTINE obc_spg( kt )        ! Empty routine 
    643601      INTEGER, INTENT( in ) :: kt 
    644       WRITE(*,*) kt 
     602      WRITE(*,*) 'obc_spg: You should not have seen this print! error?', kt 
    645603   END SUBROUTINE obc_spg 
    646604#endif 

  • trunk/NEMO/OPA_SRC/OBC/obctra.F90

    r3 r32  
    2020   USE obc_oce         ! ocean open boundary conditions 
    2121   USE lib_mpp         ! ??? 
     22   USE lbclnk          ! ??? 
    2223   USE in_out_manager  ! I/O manager 
    2324 
    … …  
    2930 
    3031   !! * Module variables 
    31    INTEGER ::   ji, jj, jk      ! dummy loop indices 
    32  
    3332   INTEGER ::      & ! ... boundary space indices  
    3433      nib   = 1,   & ! nib   = boundary point 
    … …  
    9089      END IF 
    9190 
    92       ! 1. East open boundary 
    93       ! --------------------- 
    94  
    95       IF( lpeastobc )THEN 
    96          CALL obc_tra_east( kt ) 
    97       END IF 
    98  
    99       ! 2. West open boundary 
    100       ! --------------------- 
    101  
    102       IF( lpwestobc )THEN 
    103          CALL obc_tra_west( kt ) 
    104       END IF 
    105  
    106       ! 3. North open boundary 
    107       ! --------------------- 
    108  
    109       IF( lpnorthobc )THEN 
    110          CALL obc_tra_north( kt ) 
    111       END IF 
    112  
    113       ! 4. South open boundary 
    114       ! --------------------- 
    115  
    116       IF( lpsouthobc )THEN 
    117          CALL obc_tra_south( kt ) 
    118       END IF 
    119  
    120 # if defined key_mpp 
    121       !! bug ??? 
    122       IF( kt >= nit000+3 .AND. ln_rstart ) THEN 
    123          CALL mpp_lnk_3d( tb, 'T', 1. ) 
    124          CALL mpp_lnk_3d( sb, 'T', 1. ) 
    125       END IF 
    126       CALL mpp_lnk_3d( ta, 'T', 1. ) 
    127       CALL mpp_lnk_3d( sa, 'T', 1. ) 
    128 # endif 
     91      IF( lpeastobc  )   CALL obc_tra_east ( kt )    ! East open boundary 
     92 
     93      IF( lpwestobc  )   CALL obc_tra_west ( kt )    ! West open boundary 
     94 
     95      IF( lpnorthobc )   CALL obc_tra_north( kt )    ! North open boundary 
     96 
     97      IF( lpsouthobc )   CALL obc_tra_south( kt )    ! South open boundary 
     98 
     99      IF( lk_mpp ) THEN                  !!bug ??? 
     100         IF( kt >= nit000+3 .AND. ln_rstart ) THEN 
     101            CALL lbc_lnk( tb, 'T', 1. ) 
     102            CALL lbc_lnk( sb, 'T', 1. ) 
     103         END IF 
     104         CALL lbc_lnk( ta, 'T', 1. ) 
     105         CALL lbc_lnk( sa, 'T', 1. ) 
     106      ENDIF 
    129107 
    130108   END SUBROUTINE obc_tra 
    … …  
    151129 
    152130      !! * Local declaration 
     131      INTEGER ::   ji, jj, jk      ! dummy loop indices 
    153132      REAL(wp) ::   z05cx, ztau, zin 
    154  
    155       !!------------------------------------------------------------------------------ 
    156       !!  OPA 8.5, LODYC-IPSL (2002) 
    157133      !!------------------------------------------------------------------------------ 
    158134 
    … …  
    253229 
    254230      !! * Local declaration 
     231      INTEGER ::   ji, jj, jk      ! dummy loop indices 
    255232      REAL(wp) ::   z05cx, ztau, zin 
    256233      !!------------------------------------------------------------------------------ 
    … …  
    351328 
    352329      !! * Local declaration 
     330      INTEGER ::   ji, jj, jk      ! dummy loop indices 
    353331      REAL(wp) ::   z05cx, ztau, zin 
    354332      !!------------------------------------------------------------------------------ 
    … …  
    452430 
    453431      !! * Local declaration 
     432      INTEGER ::   ji, jj, jk      ! dummy loop indices 
    454433      REAL(wp) ::   z05cx, ztau, zin 
    455434      !!------------------------------------------------------------------------------ 

  • trunk/NEMO/OPA_SRC/OBC/obcvol.F90

    r3 r32  
    22   !!================================================================================= 
    33   !!                       ***  MODULE  obcvol  *** 
    4    !! Ocean dynamic :  Volume constraint when OBC and Free surface are activated 
     4   !! Ocean dynamic :  Volume constraint when OBC and Free surface are used 
    55   !!================================================================================= 
    6 #if defined key_obc && defined key_dynspg_fsc 
     6#if   defined key_obc   &&  defined key_dynspg_fsc 
    77   !!--------------------------------------------------------------------------------- 
    88   !!   'key_obc'               and                           open boundary conditions 
    … …  
    7373      !! 
    7474      !! History : 
    75       !!   8.5  !  02-10 (C. Talandier, A-M. Treguier) Original 
     75      !!   8.5  !  02-10 (C. Talandier, A-M. Treguier) Original code 
    7676      !!---------------------------------------------------------------------------- 
    7777      !! * Arguments 
    … …  
    102102         END DO 
    103103      END DO 
    104  
    105 # if defined key_mpp 
    106       CALL mpp_sum( zCflxemp ) 
    107 # endif 
     104      IF( lk_mpp )   CALL mpp_sum( zCflxemp )   ! sum over the global domain 
    108105 
    109106      ! 2. Barotropic velocity for each open boundary 
    … …  
    113110 
    114111      ! ... West open boundary 
    115       IF( lpwestobc ) THEN 
    116  
    117          ! ... Total transport through the West OBC 
     112      IF( lpwestobc ) THEN                      ! ... Total transport through the West OBC 
    118113         DO ji = fs_niw0, fs_niw1 ! Vector opt. 
    119114            DO jk = 1, jpkm1 
    120115               DO jj = 1, jpj 
    121                   zubtpecor = zubtpecor + ua(ji,jj,jk)*e2u(ji,jj)*fse3u(ji,jj,jk) & 
    122                                         * uwmsk(jj,jk) 
    123                END DO 
    124             END DO 
    125          END DO 
    126  
     116                  zubtpecor = zubtpecor + ua(ji,jj,jk)*e2u(ji,jj)*fse3u(ji,jj,jk) * uwmsk(jj,jk) 
     117               END DO 
     118            END DO 
     119         END DO 
    127120      END IF  
    128121 
    129122      ! ... East open boundary 
    130       IF( lpeastobc ) THEN 
    131  
    132          ! ... Total transport through the East OBC 
     123      IF( lpeastobc ) THEN                      ! ... Total transport through the East OBC 
    133124         DO ji = fs_nie0, fs_nie1 ! Vector opt. 
    134125            DO jk = 1, jpkm1 
    135126               DO jj = 1, jpj 
    136                   zubtpecor = zubtpecor - ua(ji,jj,jk)*e2u(ji,jj)*fse3u(ji,jj,jk) & 
    137                                         * uemsk(jj,jk) 
    138                END DO 
    139             END DO 
    140          END DO 
    141  
     127                  zubtpecor = zubtpecor - ua(ji,jj,jk)*e2u(ji,jj)*fse3u(ji,jj,jk) * uemsk(jj,jk) 
     128               END DO 
     129            END DO 
     130         END DO 
    142131      END IF  
    143132 
    144133      ! ... North open boundary 
    145       IF( lpnorthobc ) THEN 
    146  
    147          ! ... Total transport through the North OBC 
     134      IF( lpnorthobc ) THEN                     ! ... Total transport through the North OBC 
    148135         DO jj = fs_njn0, fs_njn1 ! Vector opt. 
    149136            DO jk = 1, jpkm1 
    150137               DO ji = 1, jpi 
    151                   zubtpecor = zubtpecor - va(ji,jj,jk)*e1v(ji,jj)*fse3v(ji,jj,jk) & 
    152                                         * vnmsk(ji,jk) 
    153                END DO 
    154             END DO 
    155          END DO 
    156  
     138                  zubtpecor = zubtpecor - va(ji,jj,jk)*e1v(ji,jj)*fse3v(ji,jj,jk) * vnmsk(ji,jk) 
     139               END DO 
     140            END DO 
     141         END DO 
    157142      END IF  
    158143 
    159144      ! ... South open boundary 
    160       IF( lpsouthobc ) THEN 
    161  
    162          ! ... Total transport through the South OBC 
     145      IF( lpsouthobc ) THEN                     ! ... Total transport through the South OBC 
    163146         DO jj = fs_njs0, fs_njs1 ! Vector opt. 
    164147            DO jk = 1, jpkm1 
    165148               DO ji = 1, jpi 
    166                   zubtpecor = zubtpecor + va(ji,jj,jk)*e1v(ji,jj)*fse3v(ji,jj,jk) & 
    167                                         * vsmsk(ji,jk) 
    168                END DO 
    169             END DO 
    170          END DO 
    171  
    172       END IF  
    173  
    174 # if defined key_mpp 
    175       CALL mpp_sum( zubtpecor ) 
    176 # endif 
     149                  zubtpecor = zubtpecor + va(ji,jj,jk)*e1v(ji,jj)*fse3v(ji,jj,jk) * vsmsk(ji,jk) 
     150               END DO 
     151            END DO 
     152         END DO 
     153      END IF  
     154 
     155      IF( lk_mpp )   CALL mpp_sum( zubtpecor )   ! sum over the global domain 
     156 
    177157 
    178158      ! 3. The normal velocity correction 
    … …  
    181161      zubtpecor = (zubtpecor - zCflxemp*volemp)*(1./obcsurftot) 
    182162 
    183       IF( lwp .and. mod( kt, nwrite ) == 0) THEN 
     163      IF( lwp .AND. MOD( kt, nwrite ) == 0) THEN 
    184164         IF(lwp) WRITE(numout,*)'        ' 
    185165         IF(lwp) WRITE(numout,*)'obc_vol : time step :', kt 
    … …  
    214194         END DO 
    215195 
    216 # if defined key_mpp 
    217          CALL mpp_sum( ztransw ) 
    218 # endif 
    219  
    220          IF( lwp .and. mod( kt, nwrite ) == 0) THEN 
     196         IF( lk_mpp )   CALL mpp_sum( ztransw )   ! sum over the global domain 
     197 
     198         IF( lwp .AND. MOD( kt, nwrite ) == 0) THEN 
    221199            IF(lwp) WRITE(numout,*)'          West OB transport ztransw :', ztransw,'(m3/s)' 
    222200         END IF  
    … …  
    236214         END DO 
    237215 
    238 # if defined key_mpp 
    239          CALL mpp_sum( ztranse ) 
    240 # endif 
    241  
    242          IF( lwp .and. mod( kt, nwrite ) == 0) THEN 
     216         IF( lk_mpp )   CALL mpp_sum( ztranse )   ! sum over the global domain 
     217 
     218         IF( lwp .AND. MOD( kt, nwrite ) == 0) THEN 
    243219            IF(lwp) WRITE(numout,*)'          East OB transport ztranse :', ztranse,'(m3/s)' 
    244220         END IF  
    … …  
    257233            END DO 
    258234         END DO 
    259  
    260 # if defined key_mpp 
    261          CALL mpp_sum( ztransn ) 
    262 # endif 
    263  
    264          IF( lwp .and. mod( kt, nwrite ) == 0) THEN 
     235         IF( lk_mpp )   CALL mpp_sum( ztransn )   ! sum over the global domain 
     236 
     237         IF( lwp .AND. MOD( kt, nwrite ) == 0) THEN 
    265238            IF(lwp) WRITE(numout,*)'          North OB transport ztransn :', ztransn,'(m3/s)' 
    266239         END IF  
    … …  
    279252            END DO 
    280253         END DO 
    281   
    282 # if defined key_mpp 
    283          CALL mpp_sum( ztranss ) 
    284 # endif 
    285  
    286          IF( lwp .and. mod( kt, nwrite ) == 0) THEN 
     254         IF( lk_mpp )   CALL mpp_sum( ztranss )   ! sum over the global domain 
     255 
     256         IF( lwp .AND. MOD( kt, nwrite ) == 0) THEN 
    287257            IF(lwp) WRITE(numout,*)'          South OB transport ztranss :', ztranss,'(m3/s)' 
    288258         END IF  
    … …  
    296266      ztranst = ztransw - ztranse + ztranss - ztransn 
    297267 
    298       IF( lwp .and. mod( kt, nwrite ) == 0) THEN 
     268      IF( lwp .AND. MOD( kt, nwrite ) == 0) THEN 
    299269         IF(lwp) WRITE(numout,*)'        ' 
    300270         IF(lwp) WRITE(numout,*)'          Cumulate transport ztranst =', ztranst,'(m3/s)' 

  • trunk/NEMO/OPA_SRC/TRA/traadv_cen2.F90

    r3 r32  
    6363      !!        Part I : horizontal advection 
    6464      !!      * centered flux: 
    65       !!         * s-coordinate ('key_s_coord') or 
    66       !!         * z-coordinate with partial steps ('key_partial_steps'), 
     65      !!         * s-coordinate (lk_sco=T) or 
     66      !!         * z-coordinate with partial steps (lk_zps=T), 
    6767      !!        the vertical scale factors e3. are inside the derivatives: 
    6868      !!               zcenu = e2u*e3u  un  mi(tn) 
    … …  
    7272      !!               zcenv = e1v  vn  mj(tn) 
    7373      !!      * upstream flux: 
    74       !!         * s-coordinate ('key_s_coord') or 
    75       !!         * z-coordinate with partial steps ('key_partial_steps') 
     74      !!         * s-coordinate (lk_sco=T) or 
     75      !!         * z-coordinate with partial steps (lk_zps=T) 
    7676      !!               zupsu = e2u*e3u  un  (tb(i) or tb(i-1) ) [un>0 or <0] 
    7777      !!               zupsv = e1v*e3v  vn  (tb(j) or tb(j-1) ) [vn>0 or <0] 
    … …  
    8585      !!               zwy = zcofj * zupsv + (1-zcofj) * zcenv 
    8686      !!      * horizontal advective trend (divergence of the fluxes) 
    87       !!         * s-coordinate ('key_s_coord') or 
    88       !!         * z-coordinate with partial steps ('key_partial_steps') 
     87      !!         * s-coordinate (lk_sco=T) or 
     88      !!         * z-coordinate with partial steps (lk_zps=T) 
    8989      !!               zta = 1/(e1t*e2t*e3t) { di-1[zwx] + dj-1[zwy] } 
    9090      !!         * z-coordinate (default key), e3t=e3u=e3v: 
    … …  
    180180      ! Advective bottom boundary layer  
    181181      ! ------------------------------- 
    182       zun(:,:,:) = un (:,:,:) - u_bbl(:,:,:) 
    183       zvn(:,:,:) = vn (:,:,:) - v_bbl(:,:,:) 
    184       zwn(:,:,:) = wn (:,:,:) + w_bbl(:,:,:) 
     182      zun(:,:,:) = un(:,:,:) - u_bbl(:,:,:) 
     183      zvn(:,:,:) = vn(:,:,:) - v_bbl(:,:,:) 
     184      zwn(:,:,:) = wn(:,:,:) + w_bbl(:,:,:) 
    185185#endif 
    186186 

  • trunk/NEMO/OPA_SRC/TRA/traadv_cen2_atsk.h90

    r3 r32  
    2626      !!         Part I : horizontal advection 
    2727      !!       * centered flux: 
    28       !!            * s-coordinate ('key_s_coord' defined) or 
    29       !!            * z-coordinate with partial steps ('key_partial_steps'), 
     28      !!            * s-coordinate (lk_sco=T) or 
     29      !!            * z-coordinate with partial steps (lk_zps=T), 
    3030      !!         the vertical scale factors e3. are inside the derivatives: 
    3131      !!               zcenu = e2u*e3u  un  mi(tn) 
    3232      !!               zcenv = e1v*e3v  vn  mj(tn) 
    33       !!            * z-coordinate (default key), e3t=e3u=e3v: 
     33      !!            * z-coordinate (lk_zco=T), e3t=e3u=e3v: 
    3434      !!               zcenu = e2u  un  mi(tn) 
    3535      !!               zcenv = e1v  vn  mj(tn) 
    3636      !!       * upstream flux: 
    37       !!            * s-coordinate ('key_s_coord' defined) or 
    38       !!            * z-coordinate with partial steps ('key_partial_steps') 
     37      !!            * s-coordinate (lk_sco=T) or 
     38      !!            * z-coordinate with partial steps (lk_zps=T) 
    3939      !!               zupsu = e2u*e3u  un  (tb(i) or tb(i-1) ) [un>0 or <0] 
    4040      !!               zupsv = e1v*e3v  vn  (tb(j) or tb(j-1) ) [vn>0 or <0] 
    … …  
    4848      !!               zwy = zcofj * zupsv + (1-zcofj) * zcenv 
    4949      !!       * horizontal advective trend (divergence of the fluxes) 
    50       !!            * s-coordinate ('key_s_coord' defined) 
    51       !!              or z-coordinate with partial steps ('key_partial_steps') 
     50      !!            * s-coordinate (lk_sco=T) 
     51      !!              or z-coordinate with partial steps (lk_zps=T) 
    5252      !!               zta = 1/(e1t*e2t*e3t) { di-1[zwx] + dj-1[zwy] } 
    5353      !!            * z-coordinate (default key), e3t=e3u=e3v: 
    … …  
    7777      !!        zcenu = centered flux = wn * mk(tn) 
    7878      !!         The surface boundary condition is :  
    79       !!      rigid-lid (key_dynspg_frd = T) : zero advective flux 
    80       !!      free-surf (key_dynspg_fsc = T) : wn(:,:,1) * tn(:,:,1) 
     79      !!      rigid-lid (lk_dynspg_frd = T) : zero advective flux 
     80      !!      free-surf (lk_dynspg_fsc = T) : wn(:,:,1) * tn(:,:,1) 
    8181      !!         Add this trend now to the general trend of tracer (ta,sa): 
    8282      !!            (ta,sa) = (ta,sa) + ( zta , zsa ) 

  • trunk/NEMO/OPA_SRC/TRA/trabbc.F90

    r3 r32  
    44   !! Ocean active tracers:  bottom boundary condition 
    55   !!============================================================================== 
    6 #if defined key_trabbc 
     6#if   defined key_trabbc   ||   defined key_esopa 
    77   !!---------------------------------------------------------------------- 
    88   !!   'key_trabbc'                                  geothermal heat flux 
    … …  
    2424 
    2525   !! to be transfert in the namelist ???!    
    26    LOGICAL, PUBLIC, PARAMETER ::   lk_trabbc = .TRUE.   ! bbc flag 
     26   LOGICAL, PUBLIC, PARAMETER ::   lk_trabbc = .TRUE.   !: bbc flag 
    2727 
    2828   !! * Module variables 
    … …  
    237237   !!   Default option                                         Empty module 
    238238   !!---------------------------------------------------------------------- 
    239    LOGICAL, PUBLIC, PARAMETER ::   lk_trabbc = .FALSE.  ! bbc flag 
     239   LOGICAL, PUBLIC, PARAMETER ::   lk_trabbc = .FALSE.  !: bbc flag 
    240240CONTAINS 
    241241   SUBROUTINE tra_bbc( kt )           ! Empty routine 
    242       WRITE(*,*) kt                      ! suppress a warning when compiling 
     242      WRITE(*,*) 'tra_bbc: You should not have seen this print! error?', kt 
    243243   END SUBROUTINE tra_bbc 
    244244#endif 

  • trunk/NEMO/OPA_SRC/TRA/trabbl.F90

    r3 r32  
    2929 
    3030   !! * Shared module variables 
    31    LOGICAL, PUBLIC, PARAMETER ::   & 
    32       lk_trabbl_dif = .TRUE.   ! diffusive bottom boundary layer flag 
     31   LOGICAL, PUBLIC, PARAMETER ::   &  !: 
     32      lk_trabbl_dif = .TRUE.   !: diffusive bottom boundary layer flag 
    3333# if defined key_trabbl_adv 
    34    LOGICAL, PUBLIC, PARAMETER ::    & 
    35       lk_trabbl_adv = .TRUE.   ! bottom boundary layer flag 
    36    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   & 
    37        w_bbl,      &  ! vertical increment of velocity due to advective BBL 
    38        !              ! only affect tracer vertical advection 
    39        u_bbl, v_bbl   ! velocity involved in exhanges in the advective BBL 
     34   LOGICAL, PUBLIC, PARAMETER ::    &  !: 
     35      lk_trabbl_adv = .TRUE.   !: advective bottom boundary layer flag 
     36   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &  !: 
     37       u_bbl, v_bbl,  &  !: velocity involved in exhanges in the advective BBL 
     38       w_bbl             !: vertical increment of velocity due to advective BBL 
     39       !                 !  only affect tracer vertical advection 
    4040# else 
    41    LOGICAL, PUBLIC, PARAMETER ::    & 
    42       lk_trabbl_adv = .FALSE.  ! advective bottom boundary layer flag 
     41   LOGICAL, PUBLIC, PARAMETER ::    &  !: 
     42      lk_trabbl_adv = .FALSE.  !: advective bottom boundary layer flag 
    4343# endif 
    4444 
    4545   !! * Module variables 
    46    INTEGER, DIMENSION(jpi,jpj) ::   & 
     46   INTEGER, DIMENSION(jpi,jpj) ::   &  !: 
    4747      mbkt, mbku, mbkv                 ! ??? 
    4848   REAL(wp) ::        &  !!! * bbl namelist * 
    … …  
    106106      INTEGER ::   ji, jj                   ! dummy loop indices 
    107107      INTEGER ::   ik 
     108      INTEGER ::   ii0, ii1, ij0, ij1       ! temporary integers 
    108109#  if defined key_partial_steps 
    109110      INTEGER  ::   iku1, iku2, ikv1,ikv2   ! temporary intergers 
    … …  
    288289            !                                        ! ======================= 
    289290            ! Gibraltar enhancement of BBL 
    290             zkx( mi0(139):mi1(140) , mj0(102):mj1(102) ) = 4.e0 * zkx( mi0(139):mi1(140) , mj0(102):mj1(102) ) 
    291             zky( mi0(139):mi1(140) , mj0(102):mj1(102) ) = 4.e0 * zky( mi0(139):mi1(140) , mj0(102):mj1(102) ) 
     291            ij0 = 102   ;   ij1 = 102 
     292            ii0 = 139   ;   ii1 = 140   
     293            zkx( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 4.e0 * zkx( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) 
     294            zky( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 4.e0 * zky( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) 
    292295 
    293296            ! Red Sea enhancement of BBL 
    294             zkx( mi0(161):mi1(162) , mj0(88):mj1(88) ) = 10.e0 * zkx( mi0(161):mi1(162) , mj0(88):mj1(88) ) 
    295             zky( mi0(161):mi1(162) , mj0(88):mj1(88) ) = 10.e0 * zky( mi0(161):mi1(162) , mj0(88):mj1(88) ) 
     297            ij0 =  88   ;   ij1 =  88 
     298            ii0 = 161   ;   ii1 = 162 
     299            zkx( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 10.e0 * zkx( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) 
     300            zky( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 10.e0 * zky( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) 
    296301 
    297302            !                                        ! ======================= 
    … …  
    299304            !                                        ! ======================= 
    300305            ! Gibraltar enhancement of BBL 
    301             zkx( mi0(70):mi1(71) , mj0(52):mj1(52) ) = 4.e0 * zkx( mi0(70):mi1(71) , mj0(52):mj1(52) ) 
    302             zky( mi0(70):mi1(71) , mj0(52):mj1(52) ) = 4.e0 * zky( mi0(70):mi1(71) , mj0(52):mj1(52) ) 
     306            ij0 =  52   ;   ij1 =  52 
     307            ii0 =  70   ;   ii1 =  71   
     308            zkx( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 4.e0 * zkx( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) 
     309            zky( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 4.e0 * zky( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) 
    303310 
    304311         END SELECT 
    … …  
    352359   SUBROUTINE tra_bbl_adv (kt )              ! Empty routine 
    353360      INTEGER, INTENT(in) :: kt 
    354       WRITE(*,*) kt 
     361      WRITE(*,*) 'tra_bbl_adv: You should not have seen this print! error?', kt 
    355362   END SUBROUTINE tra_bbl_adv 
    356363# endif 
    … …  
    418425   !!   Dummy module :                      No bottom boundary layer scheme 
    419426   !!---------------------------------------------------------------------- 
    420    LOGICAL, PUBLIC, PARAMETER ::   lk_trabbl_dif = .FALSE. 
    421    LOGICAL, PUBLIC, PARAMETER ::   lk_trabbl_adv = .FALSE. 
     427   LOGICAL, PUBLIC, PARAMETER ::   lk_trabbl_dif = .FALSE.   !: diff bbl flag 
     428   LOGICAL, PUBLIC, PARAMETER ::   lk_trabbl_adv = .FALSE.   !: adv  bbl flag 
    422429CONTAINS 
    423430   SUBROUTINE tra_bbl_dif (kt )              ! Empty routine 
    424431      INTEGER, INTENT(in) :: kt 
    425       WRITE(*,*) kt 
     432      WRITE(*,*) 'tra_bbl_dif: You should not have seen this print! error?', kt 
    426433   END SUBROUTINE tra_bbl_dif 
    427434   SUBROUTINE tra_bbl_adv (kt )              ! Empty routine 
    428435      INTEGER, INTENT(in) :: kt 
    429       WRITE(*,*) kt 
     436      WRITE(*,*) 'tra_bbl_adv: You should not have seen this print! error?', kt 
    430437   END SUBROUTINE tra_bbl_adv 
    431438#endif 

  • trunk/NEMO/OPA_SRC/TRA/tradmp.F90

    r3 r32  
    44   !! Ocean physics: internal restoring trend on active tracers (T and S) 
    55   !!====================================================================== 
    6 #if defined key_tradmp  
     6#if   defined key_tradmp   ||   defined key_esopa 
    77   !!---------------------------------------------------------------------- 
    88   !!   key_tradmp                                         internal damping 
    … …  
    1717   USE oce             ! ocean dynamics and tracers variables 
    1818   USE dom_oce         ! ocean space and time domain variables 
    19    USE trdtra_oce     ! ocean active tracer trend variables 
     19   USE trdtra_oce      ! ocean active tracer trend variables 
    2020   USE zdf_oce         ! ocean vertical physics 
    2121   USE in_out_manager  ! I/O manager 
    … …  
    2424   USE dtasal          ! salinity data 
    2525   USE zdfmxl          ! mixed layer depth 
     26   USE lib_mpp         ! ??? 
    2627 
    2728   IMPLICIT NONE 
    … …  
    3233 
    3334   !! * Shared module variables 
    34    LOGICAL , PUBLIC ::   lk_tradmp = .TRUE.    ! internal damping flag 
     35   LOGICAL , PUBLIC, PARAMETER ::   lk_tradmp = .TRUE.    !: internal damping flag 
    3536 
    3637   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   & 
    … …  
    392393      INTEGER, PARAMETER ::   jpmois=1 
    393394      INTEGER ::   ipi, ipj, ipk       ! temporary integers 
     395      INTEGER ::   ii0, ii1, ij0, ij1  !    "          " 
    394396      INTEGER ::   & 
    395397         idmp,     &  ! logical unit for file restoring damping term 
    … …  
    408410      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
    409411         zdct 
    410  
    411       INTEGER :: ii0, ii1, ij0, ij1 
    412412      !!---------------------------------------------------------------------- 
    413413 
    … …  
    545545 
    546546            ! Mediterranean Sea 
    547             zmrs( mi0(81):mi1(91) , mj0(50):mj1(56) ) = 1.e0  
    548             zmrs( mi0(81):mi1(91) , mj0(50):mj1(56) ) = 1.e0 
    549             zmrs( mi0(75):mi1(80) , mj0(50):mj1(55) ) = 1.e0 
    550             zmrs( mi0(70):mi1(74) , mj0(52):mj1(53) ) = 1.e0 
     547            ij0 =  50   ;   ij1 =  56 
     548            ii0 =  81   ;   ii1 =  91   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0 
     549            ij0 =  50   ;   ij1 =  55 
     550            ii0 =  70   ;   ii1 =  80   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0 
     551            ij0 =  52   ;   ij1 =  53 
     552            ii0 =  70   ;   ii1 =  74   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0 
    551553            ! Smooth transition from 0 at surface to 1./rday at the 18th level in Med and Red Sea 
    552554            DO jk = 1, 17 
    … …  
    562564 
    563565            ! Mediterranean Sea 
    564             zmrs( mi0(157):mi1(181) , mj0( 96):mj1(110) ) = 1.e0 
    565             zmrs( mi0(144):mi1(156) , mj0(100):mj1(110) ) = 1.e0 
    566             zmrs( mi0(139):mi1(143) , mj0(100):mj1(103) ) = 1.e0 
     566            ij0 =  96   ;   ij1 = 110 
     567            ii0 = 157   ;   ii1 = 181   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0 
     568            ij0 = 100   ;   ij1 = 110 
     569            ii0 = 144   ;   ii1 = 156   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0 
     570            ij0 = 100   ;   ij1 = 103 
     571            ii0 = 139   ;   ii1 = 143   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0 
    567572            ! Decrease before Gibraltar Strait 
    568             zmrs( mi0(139):mi1(141) , mj0(101):mj1(102) ) = 0.e0 
    569             zmrs( mi0(142):mi1(142) , mj0(101):mj1(102) ) = 1.e0 / 90.e0 
    570             zmrs( mi0(143):mi1(143) , mj0(101):mj1(102) ) = 0.40e0 
    571             zmrs( mi0(144):mi1(144) , mj0(101):mj1(102) ) = 0.75e0 
     573            ij0 = 101   ;   ij1 = 102 
     574            ii0 = 139   ;   ii1 = 141   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.e0 
     575            ii0 = 142   ;   ii1 = 142   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0 / 90.e0 
     576            ii0 = 143   ;   ii1 = 143   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.40e0 
     577            ii0 = 144   ;   ii1 = 144   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.75e0 
    572578            ! Red Sea 
    573             zmrs( mi0(147):mi1(163) , mj0( 87):mj1( 96) ) = 1.e0 
     579            ij0 =  87   ;   ij1 =  96 
     580            ii0 = 147   ;   ii1 = 163   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0 
    574581            ! Decrease before Bab el Mandeb Strait 
    575             zmrs( mi0(153):mi1(160) , mj0( 91):mj1( 91) ) = 0.80e0 
    576             zmrs( mi0(153):mi1(160) , mj0( 90):mj1( 90) ) = 0.40e0 
    577             zmrs( mi0(158):mi1(160) , mj0( 89):mj1( 89) ) = 1.e0 / 90.e0 
    578             zmrs( mi0(160):mi1(163) , mj0( 88):mj1( 88) ) = 0.e0 
     582            ij0 =  91   ;   ij1 =  91 
     583            ii0 = 153   ;   ii1 = 160   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.80e0 
     584            ij0 =  90   ;   ij1 =  90 
     585            ii0 = 153   ;   ii1 = 160   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.40e0 
     586            ij0 =  89   ;   ij1 =  89 
     587            ii0 = 158   ;   ii1 = 160   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0 / 90.e0 
     588            ij0 =  88   ;   ij1 =  88 
     589            ii0 = 160   ;   ii1 = 163   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.e0 
    579590            ! Smooth transition from 0 at surface to 1./rday at the 18th level in Med and Red Sea 
    580591            DO jk = 1, 17 
    … …  
    720731      IF(lwp) WRITE(numout,*) '~~~~~~' 
    721732      IF(lwp) WRITE(numout,*) 
    722 #if defined key_mpp 
    723       IF(lwp) WRITE(numout,cform_err) 
    724       IF(lwp) WRITE(numout,*) '         Computation not yet implemented with key_mpp' 
    725       IF(lwp) WRITE(numout,*) '         Rerun the code on another computer or ' 
    726       IF(lwp) WRITE(numout,*) '         create the "dist.coast.nc" file using IDL' 
    727       nstop = nstop + 1 
    728 #endif 
     733      IF( lk_mpp ) THEN 
     734         IF(lwp) WRITE(numout,cform_err) 
     735         IF(lwp) WRITE(numout,*) '         Computation not yet implemented with key_mpp_...' 
     736         IF(lwp) WRITE(numout,*) '         Rerun the code on another computer or ' 
     737         IF(lwp) WRITE(numout,*) '         create the "dist.coast.nc" file using IDL' 
     738         nstop = nstop + 1 
     739      ENDIF 
    729740 
    730741      pdct(:,:,:) = 0.e0 
    … …  
    874885   !!   Default key                                     NO internal damping 
    875886   !!---------------------------------------------------------------------- 
    876    LOGICAL , PUBLIC ::   lk_tradmp = .FALSE.    ! internal damping flag 
     887   LOGICAL , PUBLIC, PARAMETER ::   lk_tradmp = .FALSE.    !: internal damping flag 
    877888CONTAINS 
    878889   SUBROUTINE tra_dmp( kt )        ! Empty routine 
    879       WRITE(*,*) kt 
     890      WRITE(*,*) 'tra_dmp: You should not have seen this print! error?', kt 
    880891   END SUBROUTINE tra_dmp 
    881892#endif 

  • trunk/NEMO/OPA_SRC/TRA/traldf_bilapg.F90

    r3 r32  
    388388CONTAINS 
    389389   SUBROUTINE tra_ldf_bilapg( kt )               ! Dummy routine 
    390       WRITE(*,*) kt 
     390      WRITE(*,*) 'tra_ldf_bilapg: You should not have seen this print! error?', kt 
    391391   END SUBROUTINE tra_ldf_bilapg 
    392392#endif 

  • trunk/NEMO/OPA_SRC/TRA/traldf_iso.F90

    r3 r32  
    253253CONTAINS 
    254254   SUBROUTINE tra_ldf_iso( kt )               ! Empty routine 
    255       WRITE(*,*) kt 
     255      WRITE(*,*) 'tra_ldf_iso: You should not have seen this print! error?', kt 
    256256   END SUBROUTINE tra_ldf_iso 
    257257#endif 

  • trunk/NEMO/OPA_SRC/TRA/traqsr.F90

    r3 r32  
    2525   PUBLIC tra_qsr_init ! routine called by opa.F90 
    2626 
    27    LOGICAL, PUBLIC ::   ln_traqsr = .TRUE.   ! qsr flag (Default=T) 
     27   !! * Shared module variables 
     28   LOGICAL, PUBLIC ::   ln_traqsr = .TRUE.   !: qsr flag (Default=T) 
    2829 
    2930   !! * Module variables 

  • trunk/NEMO/OPA_SRC/TRA/trazdf_iso.F90

    r3 r32  
    137137         zsfw, zdis, zdjs, zdj1s,   & 
    138138         zavt, zavs 
    139 #if defined key_traldf_eiv 
     139#if defined key_traldf_eiv   ||   defined key_esopa 
    140140      REAL(wp), DIMENSION(jpi,jpk) ::   & 
    141141         ztfwg, zsfwg 
    … …  
    538538CONTAINS 
    539539   SUBROUTINE tra_zdf_iso( kt )              ! empty routine 
    540       WRITE(*,*) kt 
     540      WRITE(*,*) 'tra_zdf_iso: You should not have seen this print! error?', kt 
    541541   END SUBROUTINE tra_zdf_iso 
    542542#endif 

  • trunk/NEMO/OPA_SRC/TRA/trazdf_iso_vopt.F90

    r3 r32  
    686686CONTAINS 
    687687   SUBROUTINE tra_zdf_iso_vopt( kt )              ! empty routine 
    688       WRITE(*,*) kt 
     688      WRITE(*,*) 'tra_zdf_iso_vopt: You should not have seen this print! error?', kt 
    689689   END SUBROUTINE tra_zdf_iso_vopt 
    690690#endif 

  • trunk/NEMO/OPA_SRC/TRA/zpshde.F90

    r3 r32  
    250250      REAL(wp), DIMENSION(:,:,:) :: ptem, psal, prd 
    251251      REAL(wp) :: pgtu, pgsu, pgru, pgtv, pgsv, pgrv 
    252       WRITE(*,*) kt, ptem, psal, prd, pgtu, pgsu, pgru, pgtv, pgsv, pgrv 
     252      WRITE(*,*) 'zps_hde: You should not have seen this print! error?',   & 
     253         kt, ptem, psal, prd, pgtu, pgsu, pgru, pgtv, pgsv, pgrv 
    253254   END SUBROUTINE zps_hde 
    254255#endif 
Note: See TracChangeset for help on using the changeset viewer.