Changeset 2690


Ignore:
Timestamp:
2011-03-15T16:27:46+01:00 (10 years ago)
Author:
gm
Message:

dynamic mem: #785 ; homogeneization of the coding style associated with dyn allocation

Location:
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO
Files:
148 edited

Legend:

Unmodified
Added
Removed

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_2/dom_ice_2.F90

    r2636 r2690  
    5151      ierr(:) = 0 
    5252      ! 
    53       ALLOCATE( fs2cor(jpi,jpj),  fcor(jpi,jpj),                             & 
    54          &      covrai(jpi,jpj),  area(jpi,jpj), tms(jpi,jpj), tmu(jpi,jpj), & 
    55          &      wght(jpi,jpj,2,2),  Stat=ierr(1) ) 
     53      ALLOCATE( fs2cor(jpi,jpj)     , fcor(jpi,jpj) ,                                   & 
     54         &      covrai(jpi,jpj)     , area(jpi,jpj) , tms(jpi,jpj) , tmu(jpi,jpj) ,    & 
     55         &      wght  (jpi,jpj,2,2)                                               , STAT=ierr(1) ) 
    5656         ! 
    57       ALLOCATE(                                                              & 
     57      ALLOCATE(                                                    & 
    5858#if defined key_lim2_vp  
    59          &        akappa(jpi,jpj,2,2), bkappa(jpi,jpj,2,2),                  & 
    60          &        alambd(jpi,jpj,2,2,2,2),                                   & 
     59         &        akappa(jpi,jpj,2,2)     , bkappa(jpi,jpj,2,2),   & 
     60         &        alambd(jpi,jpj,2,2,2,2) ,                        & 
    6161#else 
    62          &        tmv(jpi,jpj), tmf(jpi,jpj), tmi(jpi,jpj),                  & 
     62         &        tmv(jpi,jpj) , tmf(jpi,jpj) , tmi(jpi,jpj) ,     & 
    6363#endif 
    64          &        Stat=ierr(2) ) 
     64         &        STAT=ierr(2) ) 
    6565         ! 
    6666      dom_ice_alloc_2 = MAXVAL(ierr) 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_2/ice_2.F90

    r2636 r2690  
    181181      ice_alloc_2 = MAXVAL( ierr ) 
    182182      ! 
    183       IF( ice_alloc_2 /= 0 )   CALL ctl_warn('ice_alloc_2: failed to allocate arrays.') 
     183      IF( ice_alloc_2 /= 0 )   CALL ctl_warn('ice_alloc_2: failed to allocate arrays') 
    184184      ! 
    185185   END FUNCTION ice_alloc_2 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/NST_SRC/agrif_oce.F90

    r2677 r2690  
    2121   LOGICAL , PUBLIC ::   ln_spc_dyn    = .FALSE.   !: 
    2222   INTEGER , PUBLIC ::   nn_cln_update = 3         !: update frequency  
    23    REAL(wp), PUBLIC ::   rn_sponge_tra = 2800.       !: sponge coeff. for tracers 
    24    REAL(wp), PUBLIC ::   rn_sponge_dyn = 2800.       !: sponge coeff. for dynamics 
     23   REAL(wp), PUBLIC ::   rn_sponge_tra = 2800.     !: sponge coeff. for tracers 
     24   REAL(wp), PUBLIC ::   rn_sponge_dyn = 2800.     !: sponge coeff. for dynamics 
    2525 
    2626   !                                              !!! OLD namelist names 
    … …  
    3131   LOGICAL , PUBLIC :: spongedoneT = .FALSE.   !: tracer   sponge layer indicator 
    3232   LOGICAL , PUBLIC :: spongedoneU = .FALSE.   !: dynamics sponge layer indicator 
    33    REAL(wp), PUBLIC, ALLOCATABLE, SAVE,  DIMENSION(:,:) ::   spe1ur, spe2vr ,spbtr2, spe1ur2, spe2vr2, spbtr3   !: ??? 
     33 
     34   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,  DIMENSION(:,:) ::   spe1ur , spe2vr , spbtr2   !: ??? 
     35   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,  DIMENSION(:,:) ::   spe1ur2, spe2vr2, spbtr3   !: ??? 
    3436    
    35    INTEGER :: tn_id,sn_id,tb_id,sb_id,ta_id,sa_id 
     37   INTEGER :: tn_id, sn_id, tb_id, sb_id, ta_id, sa_id 
    3638   INTEGER :: un_id, vn_id, ua_id, va_id 
    3739   INTEGER :: e1u_id, e2v_id, sshn_id, gcb_id 
    3840   INTEGER :: trn_id, trb_id, tra_id 
    3941 
    40    CONTAINS  
     42   !!---------------------------------------------------------------------- 
     43   !! NEMO/NST 3.3.1 , NEMO Consortium (2011) 
     44   !! $Id$ 
     45   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     46   !!---------------------------------------------------------------------- 
     47CONTAINS  
    4148 
    42    FUNCTION agrif_oce_alloc() 
    43      IMPLICIT none 
    44      INTEGER :: agrif_oce_alloc 
    45      INTEGER :: ierr 
    46  
    47      ALLOCATE(spe1ur (jpi,jpj), spe2vr (jpi,jpj), spbtr2(jpi,jpj), & 
    48               spe1ur2(jpi,jpj), spe2vr2(jpi,jpj), spbtr3(jpi,jpj),  & 
    49               Stat = ierr )  
    50  
    51       agrif_oce_alloc = ierr  
    52  
     49   INTEGER FUNCTION agrif_oce_alloc() 
     50      !!---------------------------------------------------------------------- 
     51      !!                ***  FUNCTION agrif_oce_alloc  *** 
     52      !!---------------------------------------------------------------------- 
     53      ALLOCATE( spe1ur (jpi,jpj) , spe2vr (jpi,jpj) , spbtr2(jpi,jpj) ,      & 
     54         &      spe1ur2(jpi,jpj) , spe2vr2(jpi,jpj) , spbtr3(jpi,jpj) , STAT = agrif_oce_alloc )  
    5355   END FUNCTION agrif_oce_alloc 
    5456 
    5557#endif 
    56    !!---------------------------------------------------------------------- 
    57    !! NEMO/NST 3.3 , NEMO Consortium (2010) 
    58    !! $Id$ 
    59    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    6058   !!====================================================================== 
    6159END MODULE agrif_oce 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/NST_SRC/agrif_user.F90

    r2677 r2690  
    1616      USE Agrif_Util 
    1717      USE nemogcm 
    18       !! 
    19       IMPLICIT NONE 
    20       !! 
     18      ! 
     19      IMPLICIT NONE 
     20      !!---------------------------------------------------------------------- 
     21      ! 
    2122      IF( .NOT. Agrif_Root() ) THEN 
    2223         jpni = Agrif_Parent(jpni) 
    … …  
    5960      USE obc_par 
    6061#endif 
    61       !! 
    62       IMPLICIT NONE 
    63       !! 
     62      IMPLICIT NONE 
     63      !!---------------------------------------------------------------------- 
    6464 
    6565      ! 0. Initializations 
    … …  
    9191 
    9292# if ! defined key_offline 
     93 
    9394   SUBROUTINE Agrif_InitValues_cont 
    9495      !!---------------------------------------------------------------------- 
    9596      !!                 *** ROUTINE Agrif_InitValues_cont *** 
    9697      !! 
    97       !! ** Purpose :: Declaration of variables to be interpolated 
     98      !! ** Purpose ::   Declaration of variables to be interpolated 
    9899      !!---------------------------------------------------------------------- 
    99100      USE Agrif_Util 
    … …  
    106107      USE agrif_opa_interp 
    107108      USE agrif_opa_sponge 
    108       !! 
    109       IMPLICIT NONE 
    110       !! 
     109      ! 
     110      IMPLICIT NONE 
     111      ! 
    111112      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: tabtemp 
    112113      LOGICAL :: check_namelist 
    113114      !!---------------------------------------------------------------------- 
    114115 
    115       ALLOCATE(tabtemp(jpi, jpj, jpk)) 
     116      ALLOCATE( tabtemp(jpi,jpj,jpk) ) 
    116117       
    117118       
    … …  
    144145      
    145146         ! Check time steps            
    146          IF( nint(Agrif_Rhot()) * nint(rdt) .ne. Agrif_Parent(rdt) ) THEN 
     147         IF( NINT(Agrif_Rhot()) * nint(rdt) /= Agrif_Parent(rdt) ) THEN 
    147148            WRITE(*,*) 'incompatible time step between grids' 
    148149            WRITE(*,*) 'parent grid value : ',Agrif_Parent(rdt) 
    … …  
    153154          
    154155         ! Check run length 
    155          IF( Agrif_IRhot() * (Agrif_Parent(nitend)- & 
    156             Agrif_Parent(nit000)+1) .ne. (nitend-nit000+1) ) THEN 
     156         IF( Agrif_IRhot() * (Agrif_Parent(nitend)-Agrif_Parent(nit000)+1) /= (nitend-nit000+1) ) THEN 
    157157            WRITE(*,*) 'incompatible run length between grids' 
    158             WRITE(*,*) 'parent grid value : ',(Agrif_Parent(nitend)- & 
    159                Agrif_Parent(nit000)+1),' time step' 
    160             WRITE(*,*) 'child  grid value : ', & 
    161                (nitend-nit000+1),' time step' 
    162             WRITE(*,*) 'value on child grid should be : ', & 
    163                Agrif_IRhot() * (Agrif_Parent(nitend)- & 
    164                Agrif_Parent(nit000)+1) 
     158            WRITE(*,*) 'parent grid value : ', (Agrif_Parent(nitend)-Agrif_Parent(nit000)+1),' time step' 
     159            WRITE(*,*) 'child  grid value : ', (nitend-nit000+1),' time step' 
     160            WRITE(*,*) 'value on child grid should be: ', Agrif_IRhot() * (Agrif_Parent(nitend)-Agrif_Parent(nit000)+1) 
    165161            STOP 
    166162         ENDIF 
    … …  
    176172               STOP 
    177173            ENDIF           
    178             IF( Agrif_Parent(e3zps_rat) .ne. e3zps_rat ) THEN 
     174            IF( Agrif_Parent(e3zps_rat) /= e3zps_rat ) THEN 
    179175               WRITE(*,*) 'incompatible e3zps_rat between grids' 
    180176               WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_rat) 
    … …  
    195191   END SUBROUTINE Agrif_InitValues_cont 
    196192 
     193 
    197194   SUBROUTINE agrif_declare_var 
    198195      !!---------------------------------------------------------------------- 
    … …  
    204201      USE oce 
    205202      IMPLICIT NONE 
     203      !!---------------------------------------------------------------------- 
    206204    
    207205      ! 1. Declaration of the type of variable which have to be interpolated 
    … …  
    294292      USE agrif_top_interp 
    295293      USE agrif_top_sponge 
    296       !! 
    297       IMPLICIT NONE 
    298       !! 
     294      ! 
     295      IMPLICIT NONE 
     296      ! 
    299297      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: tabtrtemp 
    300298      LOGICAL :: check_namelist 
    301299      !!---------------------------------------------------------------------- 
    302300 
    303       ALLOCATE(tabtrtemp(jpi, jpj, jpk, jptra)) 
     301      ALLOCATE( tabtrtemp(jpi,jpj,jpk,jptra) ) 
    304302       
    305303       
    … …  
    332330          
    333331         ! Check run length 
    334          IF( Agrif_IRhot() * (Agrif_Parent(nitend)- & 
    335             Agrif_Parent(nit000)+1) .ne. (nitend-nit000+1) ) THEN 
     332         IF( Agrif_IRhot() * (Agrif_Parent(nitend)-Agrif_Parent(nit000)+1) .ne. (nitend-nit000+1) ) THEN 
    336333            WRITE(*,*) 'incompatible run length between grids' 
    337             WRITE(*,*) 'parent grid value : ',(Agrif_Parent(nitend)- & 
    338                Agrif_Parent(nit000)+1),' time step' 
    339             WRITE(*,*) 'child  grid value : ', & 
    340                (nitend-nit000+1),' time step' 
    341             WRITE(*,*) 'value on child grid should be : ', & 
    342                Agrif_IRhot() * (Agrif_Parent(nitend)- & 
    343                Agrif_Parent(nit000)+1) 
     334            WRITE(*,*) 'parent grid value : ', (Agrif_Parent(nitend)-Agrif_Parent(nit000)+1),' time step' 
     335            WRITE(*,*) 'child  grid value : ', (nitend-nit000+1),' time step' 
     336            WRITE(*,*) 'value on child grid should be : ', Agrif_IRhot() * (Agrif_Parent(nitend)-Agrif_Parent(nit000)+1) 
    344337            STOP 
    345338         ENDIF 
    … …  
    436429# endif 
    437430    
    438    SUBROUTINE Agrif_detect( g, sizex ) 
     431   SUBROUTINE Agrif_detect( kg, ksizex ) 
    439432      !!---------------------------------------------------------------------- 
    440433      !!   *** ROUTINE Agrif_detect *** 
    441434      !!---------------------------------------------------------------------- 
    442435      USE Agrif_Types 
    443       !!  
    444       INTEGER, DIMENSION(2) :: sizex 
    445       INTEGER, DIMENSION(sizex(1),sizex(2)) :: g  
     436      ! 
     437      INTEGER, DIMENSION(2) :: ksizex 
     438      INTEGER, DIMENSION(ksizex(1),ksizex(2)) :: kg  
    446439      !!---------------------------------------------------------------------- 
    447440      ! 
    … …  
    458451      USE in_out_manager 
    459452      USE lib_mpp 
    460       !! 
    461       IMPLICIT NONE 
    462       !! 
     453      IMPLICIT NONE 
     454      ! 
    463455      NAMELIST/namagrif/ nn_cln_update, rn_sponge_tra, rn_sponge_dyn, ln_spc_dyn 
    464       INTEGER :: ierr 
    465456      !!---------------------------------------------------------------------- 
    466457      ! 
    … …  
    485476      visc_dyn      = rn_sponge_dyn 
    486477      ! 
    487       ierr = agrif_oce_alloc() 
    488       IF( ierr  > 0 )   CALL ctl_warn('agrif sol_oce_alloc: allocation of arrays failed') 
     478      IF( agrif_oce_alloc()  > 0 )   CALL ctl_warn('agrif sol_oce_alloc: allocation of arrays failed') 
    489479      ! 
    490480    END SUBROUTINE agrif_nemo_init 
    … …  
    497487      !!---------------------------------------------------------------------- 
    498488      USE dom_oce 
    499       !! 
    500       IMPLICIT NONE 
    501       !! 
    502       INTEGER :: indglob,indloc,nprocloc,i 
     489      IMPLICIT NONE 
     490      ! 
     491      INTEGER :: indglob, indloc, nprocloc, i 
    503492      !!---------------------------------------------------------------------- 
    504493      ! 
    … …  
    517506   SUBROUTINE Subcalledbyagrif 
    518507      !!---------------------------------------------------------------------- 
    519       !!   *** ROUTINE Subcalledbyagrif *** 
     508      !!                   *** ROUTINE Subcalledbyagrif *** 
    520509      !!---------------------------------------------------------------------- 
    521510      WRITE(*,*) 'Impossible to be here' 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OFF_SRC/dommsk.F90

    r2655 r2690  
    1212   USE oce             ! ocean dynamics and tracers 
    1313   USE dom_oce         ! ocean space and time domain 
    14    USE lib_mpp 
    15    USE in_out_manager 
     14   USE lib_mpp         ! MPP library 
     15   USE in_out_manager  ! I/O manager 
    1616 
    1717   IMPLICIT NONE 
    … …  
    2020   PUBLIC   dom_msk    ! routine called by inidom.F90 
    2121 
    22    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   facvol  !! volume for degraded regions 
     22   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   facvol   !: volume for degraded regions 
    2323 
    2424   !! * Substitutions 
    … …  
    3131CONTAINS 
    3232 
    33     
    3433   SUBROUTINE dom_msk 
    3534      !!--------------------------------------------------------------------- 
    … …  
    4645      !!               tpol     : ??? 
    4746      !!---------------------------------------------------------------------- 
    48       USE wrk_nemo, ONLY: iwrk_in_use, iwrk_not_released 
    49       USE wrk_nemo, ONLY: imsk => iwrk_2d_1 
     47      USE wrk_nemo, ONLY:   iwrk_in_use, iwrk_not_released 
     48      USE wrk_nemo, ONLY:   imsk => iwrk_2d_1 
     49      ! 
    5050      INTEGER  ::   ji, jk                   ! dummy loop indices 
    5151      INTEGER  ::   iif, iil, ijf, ijl       ! local integers 
    … …  
    5353      ! 
    5454      IF( iwrk_in_use(2, 1) ) THEN 
    55          CALL ctl_stop('dom_msk: ERROR: requested workspace arrays unavailable.')  ;  RETURN 
     55         CALL ctl_stop('dom_msk: requested workspace arrays unavailable')   ;   RETURN 
    5656      END IF 
    5757      ! 
    58       CALL dom_msk_alloc 
     58#if defined key_degrad 
     59      IF( dom_msk_alloc() /= 0 )   CALL ctl_stop('STOP','dom_msk: unable to allocate arrays') 
     60#endif 
    5961 
    6062      ! Interior domain mask (used for global sum) 
    … …  
    99101      ENDIF 
    100102      ! 
    101       IF( iwrk_not_released(2, 1) ) CALL ctl_stop('dom_msk: failed to release workspace arrays.') 
     103      IF( iwrk_not_released(2, 1) )   CALL ctl_stop('dom_msk: failed to release workspace arrays') 
    102104      ! 
    103105   END SUBROUTINE dom_msk 
    104106 
    105    SUBROUTINE dom_msk_alloc() 
     107 
     108   INTEGER FUNCTION dom_msk_alloc() 
    106109      !!--------------------------------------------------------------------- 
    107       !!                 ***  ROUTINE dom_msk_alloc  *** 
     110      !!                 ***  FUNCTION dom_msk_alloc  *** 
    108111      !!--------------------------------------------------------------------- 
    109 #if defined key_degrad 
    110       INTEGER :: ierr  
    111  
    112       ALLOCATE( facvol(jpi,jpj,jpk), STAT=ierr ) 
    113       IF( ierr /= 0 )  & 
    114         &           CALL ctl_stop('STOP', 'dom_msk : unable to allocate facvol array') 
    115 #endif 
    116  
     112      ALLOCATE( facvol(jpi,jpj,jpk) , STAT=dom_msk_alloc ) 
     113      IF( dom_msk_alloc /= 0 )   CALL ctl_warn('dom_msk_alloc : failed to allocate facvol array') 
     114      ! 
    117115   END SUBROUTINE dom_msk_alloc 
    118116 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90

    r2648 r2690  
    296296   END SUBROUTINE dta_dyn 
    297297 
     298 
    298299   INTEGER FUNCTION dta_dyn_alloc() 
    299300      !!--------------------------------------------------------------------- 
    … …  
    302303 
    303304      ALLOCATE( tdta    (jpi,jpj,jpk,2), sdta    (jpi,jpj,jpk,2),    & 
    304        &        udta    (jpi,jpj,jpk,2), vdta    (jpi,jpj,jpk,2),    & 
    305        &        wdta    (jpi,jpj,jpk,2), avtdta  (jpi,jpj,jpk,2),    & 
     305         &      udta    (jpi,jpj,jpk,2), vdta    (jpi,jpj,jpk,2),    & 
     306         &      wdta    (jpi,jpj,jpk,2), avtdta  (jpi,jpj,jpk,2),    & 
    306307#if defined key_ldfslp  
    307        &        uslpdta (jpi,jpj,jpk,2), vslpdta (jpi,jpj,jpk,2),    & 
    308        &        wslpidta(jpi,jpj,jpk,2), wslpjdta(jpi,jpj,jpk,2),    & 
     308         &      uslpdta (jpi,jpj,jpk,2), vslpdta (jpi,jpj,jpk,2),    & 
     309         &      wslpidta(jpi,jpj,jpk,2), wslpjdta(jpi,jpj,jpk,2),    & 
    309310#endif 
    310311#if defined key_degrad 
    311        &        ahtudta (jpi,jpj,jpk,2), ahtvdta (jpi,jpj,jpk,2),    & 
    312        &        ahtwdta (jpi,jpj,jpk,2),                             & 
     312         &      ahtudta (jpi,jpj,jpk,2), ahtvdta (jpi,jpj,jpk,2),    & 
     313         &      ahtwdta (jpi,jpj,jpk,2),                             & 
    313314# if defined key_traldf_eiv 
    314        &        aeiudta (jpi,jpj,jpk,2), aeivdta (jpi,jpj,jpk,2),    & 
    315        &        aeiwdta (jpi,jpj,jpk,2),                             & 
     315         &      aeiudta (jpi,jpj,jpk,2), aeivdta (jpi,jpj,jpk,2),    & 
     316         &      aeiwdta (jpi,jpj,jpk,2),                             & 
    316317# endif 
    317318#endif 
    318319#if ! defined key_degrad &&  defined key_traldf_c2d && defined key_traldf_eiv 
    319        &        aeiwdta (jpi,jpj,    2),                             & 
    320 #endif 
    321  
    322        &        hmlddta (jpi,jpj,    2), wspddta (jpi,jpj,    2),    & 
    323        &        frlddta (jpi,jpj,    2), qsrdta  (jpi,jpj,    2),    & 
    324        &        empdta  (jpi,jpj,    2),                         STAT=dta_dyn_alloc )  
    325  
    326       IF( dta_dyn_alloc /= 0 ) CALL ctl_warn('dta_dyn_alloc: failed to allocate facvol array.') 
    327  
     320         &      aeiwdta (jpi,jpj,    2),                             & 
     321#endif 
     322         &      hmlddta (jpi,jpj,    2), wspddta (jpi,jpj,    2),    & 
     323         &      frlddta (jpi,jpj,    2), qsrdta  (jpi,jpj,    2),    & 
     324         &      empdta  (jpi,jpj,    2),                         STAT=dta_dyn_alloc )  
     325         ! 
     326      IF( dta_dyn_alloc /= 0 )   CALL ctl_warn('dta_dyn_alloc: failed to allocate facvol array') 
     327      ! 
    328328   END FUNCTION dta_dyn_alloc 
     329 
    329330 
    330331   SUBROUTINE dynrea( kt, kenr ) 
    … …  
    353354      INTEGER ::  jkenr 
    354355      !!---------------------------------------------------------------------- 
    355  
    356       ! 0. Memory allocation 
     356      !  
    357357      IF( wrk_in_use(3, 1,2,3,4,5,6,7,8,9,10,11,12,13) .OR. & 
    358358          wrk_in_use(2, 1,2,3,4,5,6,7,8,9,10)               ) THEN 
    359          CALL ctl_stop('domrea/dta_dyn: requested workspace arrays unavailable')  ;  RETURN 
    360       END IF 
     359         CALL ctl_stop('domrea/dta_dyn: requested workspace arrays unavailable')   ;   RETURN 
     360      ENDIF 
    361361       
    362362      ! cas d'un fichier non periodique : on utilise deux fois le premier et 
    … …  
    488488      IF( wrk_not_released(3, 1,2,3,4,5,6,7,8,9,10,11,12,13) .OR. & 
    489489          wrk_not_released(2, 1,2,3,4,5,6,7,8,9,10)               ) THEN 
    490          CALL ctl_stop('domrea/dta_dyn: failed to release workspace arrays.') 
     490         CALL ctl_stop('domrea/dta_dyn: failed to release workspace arrays') 
    491491      END IF 
    492492      ! 
    … …  
    503503      !!---------------------------------------------------------------------- 
    504504      REAL(wp) :: znspyr   !: number of time step per year 
    505       INTEGER  :: ierr 
    506       !! 
     505      ! 
    507506      NAMELIST/namdyn/ ndtadyn, ndtatot, nsptint, lperdyn,  & 
    508       &                cfile_grid_T, cfile_grid_U, cfile_grid_V, cfile_grid_W 
    509       !!---------------------------------------------------------------------- 
    510  
    511       ierr = dta_dyn_alloc() 
    512       IF( ierr /= 0 )  CALL ctl_stop( 'STOP', 'dta_dyn_alloc : unable to allocate standard ocean arrays' ) 
    513  
    514       !  Define the dynamical input parameters 
    515       ! ====================================== 
    516  
     507         &             cfile_grid_T, cfile_grid_U, cfile_grid_V, cfile_grid_W 
     508      !!---------------------------------------------------------------------- 
     509      ! 
     510      IF( dta_dyn_alloc() /= 0 )  CALL ctl_stop( 'STOP', 'dta_dyn_alloc: unable to allocate standard ocean arrays' ) 
     511      ! 
    517512      REWIND( numnam )              ! Read Namelist namdyn : Lateral physics on tracers 
    518513      READ  ( numnam, namdyn ) 
    519  
     514      ! 
    520515      IF(lwp) THEN                  ! control print 
    521516         WRITE(numout,*) 
    … …  
    537532      ! 
    538533      znspyr   = nyear_len(1) * rday / rdt   
    539       rnspdta  = znspyr / FLOAT( ndtadyn ) 
     534      rnspdta  = znspyr / REAL( ndtadyn, wp ) 
    540535      rnspdta2 = rnspdta * 0.5  
    541536      ! 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90

    r2669 r2690  
    4141   USE lib_mpp         ! distributed memory computing 
    4242#if defined key_iomput 
    43    USE  mod_ioclient 
     43   USE mod_ioclient 
    4444#endif  
    4545 
    … …  
    165165      ! This used to be done in par_oce.F90 when they were parameters rather 
    166166      ! than variables 
    167       jpi = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci !: first  dim. 
    168       jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj !: second dim. 
    169       jpk = jpkdta                                           !: third dim 
    170       jpim1 = jpi-1                                          !: inner domain indices 
    171       jpjm1 = jpj-1                                          !:   "           " 
    172       jpkm1 = jpk-1                                          !:   "           " 
    173       jpij  = jpi*jpj                                        !:  jpi x j 
     167      jpi = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci   ! first  dim. 
     168      jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj   ! second dim. 
     169      jpk = jpkdta                                             ! third dim 
     170      jpim1 = jpi-1                                            ! inner domain indices 
     171      jpjm1 = jpj-1                                            !   "           " 
     172      jpkm1 = jpk-1                                            !   "           " 
     173      jpij  = jpi*jpj                                          !  jpi x j 
    174174 
    175175 
    … …  
    341341   END SUBROUTINE nemo_closefile 
    342342 
     343 
    343344   SUBROUTINE nemo_alloc 
    344      !!---------------------------------------------------------------------- 
    345      !!                     ***  ROUTINE nemo_alloc  *** 
    346      !! 
    347      !! ** Purpose :   Allocate all the dynamic arrays of the OPA modules 
    348      !! 
    349      !! ** Method  : 
    350      !!---------------------------------------------------------------------- 
    351      USE diawri,       ONLY: dia_wri_alloc 
    352      USE dom_oce,      ONLY: dom_oce_alloc 
    353      USE zdf_oce,      ONLY: zdf_oce_alloc 
    354      USE zdfmxl,       ONLY: zdf_mxl_alloc 
    355      USE ldftra_oce,   ONLY: ldftra_oce_alloc 
    356      USE trc_oce,      ONLY: trc_oce_alloc 
    357  
     345      !!---------------------------------------------------------------------- 
     346      !!                     ***  ROUTINE nemo_alloc  *** 
     347      !! 
     348      !! ** Purpose :   Allocate all the dynamic arrays of the OPA modules 
     349      !! 
     350      !! ** Method  : 
     351      !!---------------------------------------------------------------------- 
     352      USE diawri,       ONLY: dia_wri_alloc 
     353      USE dom_oce,      ONLY: dom_oce_alloc 
     354      USE zdf_oce,      ONLY: zdf_oce_alloc 
     355      USE zdfmxl,       ONLY: zdf_mxl_alloc 
     356      USE ldftra_oce,   ONLY: ldftra_oce_alloc 
     357      USE trc_oce,      ONLY: trc_oce_alloc 
    358358      USE wrk_nemo,    ONLY: wrk_alloc 
    359  
     359      ! 
    360360      INTEGER :: ierr 
    361361      !!---------------------------------------------------------------------- 
    362  
     362      ! 
    363363      ierr =        oce_alloc       ()          ! ocean  
    364364      ierr = ierr + dia_wri_alloc   () 
    … …  
    371371      ierr = ierr + trc_oce_alloc   ()          ! shared TRC / TRA arrays 
    372372      ierr = ierr + wrk_alloc(numout, lwp) 
    373  
     373      ! 
    374374      IF( lk_mpp    )   CALL mpp_sum( ierr ) 
    375       IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'nemo_alloc : unable to allocate standard ocean arrays' ) 
     375      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'nemo_alloc: unable to allocate standard ocean arrays' ) 
    376376      ! 
    377377   END SUBROUTINE nemo_alloc 
     378 
    378379 
    379380   SUBROUTINE nemo_partition( num_pes ) 
    … …  
    423424   END SUBROUTINE nemo_partition 
    424425 
     426 
    425427   SUBROUTINE factorise( kfax, kmaxfax, knfax, kn, kerr ) 
    426428      !!---------------------------------------------------------------------- 
    … …  
    439441      INTEGER, PARAMETER :: ntest = 14 
    440442      INTEGER :: ilfax(ntest) 
    441  
     443      ! 
    442444      ! lfax contains the set of allowed factors. 
    443445      data (ilfax(jl),jl=1,ntest) / 16384, 8192, 4096, 2048, 1024, 512, 256,  & 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OFF_SRC/zdfmxl.F90

    r2648 r2690  
    4141      !!               ***  FUNCTION zdf_mxl_alloc  *** 
    4242      !!---------------------------------------------------------------------- 
    43       ALLOCATE( nmln(jpi,jpj), hmld(jpi,jpj), hmlp(jpi,jpj), hmlpt(jpi,jpj), STAT=zdf_mxl_alloc) 
     43      ALLOCATE( nmln(jpi,jpj), hmld(jpi,jpj), hmlp(jpi,jpj), hmlpt(jpi,jpj), STAT=zdf_mxl_alloc ) 
    4444      ! 
    4545      IF( lk_mpp             )   CALL mpp_sum ( zdf_mxl_alloc ) 
    46       IF( zdf_mxl_alloc /= 0 )   CALL ctl_warn('zdf_mxl_alloc: failed to allocate arrays.') 
     46      IF( zdf_mxl_alloc /= 0 )   CALL ctl_warn('zdf_mxl_alloc: failed to allocate arrays') 
    4747   END FUNCTION zdf_mxl_alloc 
    4848 
    … …  
    6565      !! ** Action  :   nmln, hmld, hmlp, hmlpt 
    6666      !!---------------------------------------------------------------------- 
    67       USE wrk_nemo, ONLY: iwrk_in_use, iwrk_not_released 
    68       USE wrk_nemo, ONLY: imld => iwrk_2d_1    ! 2D integer workspace 
     67      USE wrk_nemo, ONLY:   iwrk_in_use, iwrk_not_released 
     68      USE wrk_nemo, ONLY:   imld => iwrk_2d_1    ! 2D integer workspace 
    6969      !! 
    70       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
     70      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    7171      !! 
    72       INTEGER                     ::   ji, jj, jk          ! dummy loop indices 
    73       INTEGER                     ::   iikn, iiki          ! temporary integer within a do loop 
    74       REAL(wp)                    ::   zrho_c = 0.01_wp    ! density criterion for mixed layer depth 
    75       REAL(wp)                    ::   zavt_c = 5.e-4_wp   ! Kz criterion for the turbocline depth 
     72      INTEGER  ::   ji, jj, jk          ! dummy loop indices 
     73      INTEGER  ::   iikn, iiki          ! temporary integer within a do loop 
     74      REAL(wp) ::   zrho_c = 0.01_wp    ! density criterion for mixed layer depth 
     75      REAL(wp) ::   zavt_c = 5.e-4_wp   ! Kz criterion for the turbocline depth 
    7676      !!---------------------------------------------------------------------- 
    7777 
    78       IF( iwrk_in_use(2, 1) )THEN 
     78      IF( iwrk_in_use(2, 1) ) THEN 
    7979         CALL ctl_stop('zdf_mxl : requested workspace array unavailable')   ;   RETURN 
    80       END IF 
     80      ENDIF 
    8181 
    8282      IF( kt == nit000 ) THEN 
    … …  
    112112      IF(ln_ctl)   CALL prt_ctl( tab2d_1=REAL(nmln,wp), clinfo1=' nmln : ', tab2d_2=hmlp, clinfo2=' hmlp : ', ovlap=1 ) 
    113113      ! 
    114       IF( iwrk_not_released(2, 1) )   CALL ctl_stop('zdf_mxl : failed to release workspace array') 
     114      IF( iwrk_not_released(2, 1) )   CALL ctl_stop('zdf_mxl: failed to release workspace array') 
    115115      ! 
    116116   END SUBROUTINE zdf_mxl 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90

    r2633 r2690  
    6565      !! ** Purpose :   compute and output some AR5 diagnostics 
    6666      !!---------------------------------------------------------------------- 
    67       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    68       USE wrk_nemo, ONLY: zarea_ssh => wrk_2d_1, zbotpres => wrk_2d_2 
    69       USE wrk_nemo, ONLY: zrhd => wrk_3d_1, zrhop => wrk_3d_2 
    70       USE wrk_nemo, ONLY: ztsn => wrk_4d_1 
    71       !! 
     67      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     68      USE wrk_nemo, ONLY:   zarea_ssh => wrk_2d_1 , zbotpres => wrk_2d_2   ! 2D workspace 
     69      USE wrk_nemo, ONLY:   zrhd      => wrk_3d_1 , zrhop    => wrk_3d_2   ! 3D      - 
     70      USE wrk_nemo, ONLY:   ztsn      => wrk_4d_1                          ! 4D      - 
     71      ! 
    7272      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    73       !! 
     73      ! 
    7474      INTEGER  ::   ji, jj, jk                      ! dummy loop arguments 
    7575      REAL(wp) ::   zvolssh, zvol, zssh_steric, zztmp, zarho, ztemp, zsal, zmass 
    7676      !!-------------------------------------------------------------------- 
    7777 
    78       IF( wrk_in_use(2, 1,2) .OR. & 
    79           wrk_in_use(3, 1,2) .OR. & 
    80           wrk_in_use(4, 1) )THEN 
     78      IF( wrk_in_use(2, 1,2) .OR.   & 
     79          wrk_in_use(3, 1,2) .OR.   & 
     80          wrk_in_use(4, 1)   ) THEN 
    8181         CALL ctl_stop('dia_ar5: requested workspace arrays unavailable')   ;   RETURN 
    82       END IF 
     82      ENDIF 
    8383 
    8484      CALL iom_put( 'cellthc', fse3t(:,:,:) ) 
    … …  
    160160      CALL iom_put( 'saltot' , zsal  ) 
    161161      ! 
    162       IF( wrk_not_released(2, 1,2) .OR. & 
    163           wrk_not_released(3, 1,2) .OR. & 
    164           wrk_not_released(4, 1) )THEN 
    165          CALL ctl_stop('dia_ar5: failed to release workspace arrays') 
    166       END IF 
     162      IF( wrk_not_released(2, 1,2) .OR.   & 
     163          wrk_not_released(3, 1,2) .OR.   & 
     164          wrk_not_released(4, 1)   )   CALL ctl_stop('dia_ar5: failed to release workspace arrays') 
    167165      ! 
    168166   END SUBROUTINE dia_ar5 
    … …  
    175173      !! ** Purpose :   initialization for AR5 diagnostic computation 
    176174      !!---------------------------------------------------------------------- 
    177       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    178       USE wrk_nemo, ONLY: wrk_4d_1 
    179       !! 
     175      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     176      USE wrk_nemo, ONLY:   wrk_4d_1      ! 4D workspace 
     177      ! 
    180178      INTEGER  ::   inum 
    181179      INTEGER  ::   ik 
    … …  
    185183      !!---------------------------------------------------------------------- 
    186184      ! 
    187       IF(wrk_in_use(4, 1))THEN 
     185      IF(wrk_in_use(4, 1) ) THEN 
    188186         CALL ctl_stop('dia_ar5_init: requested workspace array unavailable.')   ;   RETURN 
    189       END IF 
     187      ENDIF 
    190188      zsaldta => wrk_4d_1(:,:,:,1:2) 
    191189 
    … …  
    223221      ENDIF 
    224222      ! 
    225       IF(wrk_not_released(4, 1))THEN 
    226          CALL ctl_stop('dia_ar5_init: failed to release workspace array.') 
    227       END IF 
     223      IF( wrk_not_released(4, 1) )   CALL ctl_stop('dia_ar5_init: failed to release workspace array') 
    228224      ! 
    229225   END SUBROUTINE dia_ar5_init 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90

    r2633 r2690  
    210210      !!---------------------------------------------------------------------- 
    211211#if defined key_mpp_mpi 
    212       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    213       USE wrk_nemo, ONLY: zwork => wrk_1d_1 
     212      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     213      USE wrk_nemo, ONLY:   zwork => wrk_1d_1 
    214214#endif 
    215215      !! 
    … …  
    265265      ! 
    266266#if defined key_mpp_mpi 
    267       IF(wrk_not_released(1, 1) )   CALL ctl_stop('ptr_vjk: ERROR - failed to release workspace array') 
     267      IF( wrk_not_released(1, 1) )   CALL ctl_stop('ptr_vjk: ERROR - failed to release workspace array') 
    268268#endif 
    269269      ! 
    … …  
    282282      !!---------------------------------------------------------------------- 
    283283#if defined key_mpp_mpi 
    284       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    285       USE wrk_nemo, ONLY: zwork => wrk_1d_1 
     284      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     285      USE wrk_nemo, ONLY:   zwork => wrk_1d_1 
    286286#endif 
    287287      !! 
    … …  
    299299      ! 
    300300#if defined key_mpp_mpi 
    301       IF(wrk_in_use(1, 1))THEN 
    302          CALL ctl_stop('ptr_tjk: requested workspace array unavailable.') 
    303          RETURN 
    304       END IF 
     301      IF( wrk_in_use(1, 1) ) THEN 
     302         CALL ctl_stop('ptr_tjk: requested workspace array unavailable')   ;   RETURN 
     303      ENDIF 
    305304#endif 
    306305 
    … …  
    324323      ! 
    325324#if defined key_mpp_mpi 
    326       IF( wrk_not_released(1, 1) )   CALL ctl_stop('ptr_tjk: failed to release workspace array.') 
     325      IF( wrk_not_released(1, 1) )   CALL ctl_stop('ptr_tjk: failed to release workspace array') 
    327326#endif 
    328327      !     
    … …  
    532531      !! ** Method  :   NetCDF file 
    533532      !!---------------------------------------------------------------------- 
    534       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    535       USE wrk_nemo, ONLY: zphi => wrk_1d_1, zfoo => wrk_1d_2 
    536       USE wrk_nemo, ONLY: z_1  => wrk_2d_1 
     533      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     534      USE wrk_nemo, ONLY:   zphi => wrk_1d_1, zfoo => wrk_1d_2    ! 1D workspace 
     535      USE wrk_nemo, ONLY:   z_1  => wrk_2d_1                      ! 2D      - 
    537536      !! 
    538537      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    … …  
    551550      !!---------------------------------------------------------------------- 
    552551 
    553       IF( wrk_in_use(1, 1,2) .OR. wrk_in_use(2, 1) )THEN 
    554          CALL ctl_stop('dia_ptr_wri: ERROR: requested workspace arrays unavailable')   ;   RETURN 
    555       END IF 
     552      IF( wrk_in_use(1, 1,2) .OR. wrk_in_use(2, 1) ) THEN 
     553         CALL ctl_stop('dia_ptr_wri: requested workspace arrays unavailable')   ;   RETURN 
     554      ENDIF 
    556555 
    557556      ! define time axis 
    … …  
    867866      ENDIF 
    868867      ! 
    869       IF( wrk_not_released(1, 1,2) .OR. wrk_not_released(2, 1) )   & 
    870          CALL ctl_stop('dia_ptr_wri: failed to release workspace arrays') 
     868      IF( wrk_not_released(1, 1,2) .OR.    & 
     869          wrk_not_released(2, 1)    )   CALL ctl_stop('dia_ptr_wri: failed to release workspace arrays') 
    871870      ! 
    872871  END SUBROUTINE dia_ptr_wri 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DOM/closea.F90

    r2528 r2690  
    4646   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    4747   !! $Id$ 
    48    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    49    !!---------------------------------------------------------------------- 
    50  
     48   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     49   !!---------------------------------------------------------------------- 
    5150CONTAINS 
    5251 
    … …  
    181180      REAL(wp)                    ::   zze2 
    182181      REAL(wp), DIMENSION (jpncs) ::   zfwf  
    183   
    184182      !!---------------------------------------------------------------------- 
    185183      ! 
    … …  
    366364         DO jj = ncsj1(jc), ncsj2(jc) 
    367365            DO ji = ncsi1(jc), ncsi2(jc) 
    368                pbat(ji,jj) = 0.e0    
     366               pbat(ji,jj) = 0._wp    
    369367               kbat(ji,jj) = 0    
    370368            END DO  

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DOM/daymod.F90

    r2528 r2690  
    4646   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    4747   !! $Id$ 
    48    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     48   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4949   !!---------------------------------------------------------------------- 
    50  
    5150CONTAINS 
    5251 
    … …  
    6867      !!              - nmonth_len, nyear_len, nmonth_half, nmonth_end through day_mth 
    6968      !!---------------------------------------------------------------------- 
    70       INTEGER :: inbday, idweek 
    71       REAL(wp) :: zjul 
     69      INTEGER  ::  inbday, idweek 
     70      REAL(wp) ::   zjul 
    7271      !!---------------------------------------------------------------------- 
    7372 
    … …  
    129128      CALL day( nit000 ) 
    130129 
    131        
    132130   END SUBROUTINE day_init 
    133131 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90

    r2623 r2690  
    259259      INTEGER, DIMENSION(11) :: ierr 
    260260      !!---------------------------------------------------------------------- 
    261  
    262261      ierr(:) = 0 
    263  
     262      ! 
    264263      ALLOCATE( rdttra(jpk), r2dtra(jpk), mig(jpi), mjg(jpj), STAT=ierr(1) ) 
    265  
     264         ! 
    266265      ALLOCATE( nimppt(jpnij) , ibonit(jpnij) , nlcit(jpnij) , nlcjt(jpnij) ,     & 
    267266         &      njmppt(jpnij) , ibonjt(jpnij) , nldit(jpnij) , nldjt(jpnij) ,     & 
    268267         &                                      nleit(jpnij) , nlejt(jpnij) , STAT=ierr(2) ) 
    269  
    270       ALLOCATE( glamt(jpi,jpj), gphit(jpi,jpj), e1t(jpi,jpj), e2t(jpi,jpj),                      &  
    271          &      glamu(jpi,jpj), gphiu(jpi,jpj), e1u(jpi,jpj), e2u(jpi,jpj),                      &   
    272          &      glamv(jpi,jpj), gphiv(jpi,jpj), e1v(jpi,jpj), e2v(jpi,jpj), e1e2t(jpi,jpj) ,     &   
    273          &      glamf(jpi,jpj), gphif(jpi,jpj), e1f(jpi,jpj), e2f(jpi,jpj), ff   (jpi,jpj) , STAT=ierr(3) )      
    274  
     268         ! 
     269      ALLOCATE( glamt(jpi,jpj) , gphit(jpi,jpj) , e1t(jpi,jpj) , e2t(jpi,jpj) ,                      &  
     270         &      glamu(jpi,jpj) , gphiu(jpi,jpj) , e1u(jpi,jpj) , e2u(jpi,jpj) ,                      &   
     271         &      glamv(jpi,jpj) , gphiv(jpi,jpj) , e1v(jpi,jpj) , e2v(jpi,jpj) , e1e2t(jpi,jpj) ,     &   
     272         &      glamf(jpi,jpj) , gphif(jpi,jpj) , e1f(jpi,jpj) , e2f(jpi,jpj) , ff   (jpi,jpj) , STAT=ierr(3) )      
     273         ! 
    275274      ALLOCATE( gdep3w(jpi,jpj,jpk) , e3v(jpi,jpj,jpk) , e3f (jpi,jpj,jpk) ,                         & 
    276275         &      gdept (jpi,jpj,jpk) , e3t(jpi,jpj,jpk) , e3u (jpi,jpj,jpk) ,                         & 
    277276         &      gdepw (jpi,jpj,jpk) , e3w(jpi,jpj,jpk) , e3vw(jpi,jpj,jpk) , e3uw(jpi,jpj,jpk) , STAT=ierr(4) ) 
    278  
     277         ! 
    279278#if defined key_vvl 
    280279      ALLOCATE( gdep3w_1(jpi,jpj,jpk) , e3v_1(jpi,jpj,jpk) , e3f_1 (jpi,jpj,jpk) ,                           & 
    281280         &      gdept_1 (jpi,jpj,jpk) , e3t_1(jpi,jpj,jpk) , e3u_1 (jpi,jpj,jpk) ,                           & 
    282281         &      gdepw_1 (jpi,jpj,jpk) , e3w_1(jpi,jpj,jpk) , e3vw_1(jpi,jpj,jpk) , e3uw_1(jpi,jpj,jpk) ,     & 
    283          &      e3t_b   (jpi,jpj,jpk) , e3u_b(jpi,jpj,jpk) , e3v_b(jpi,jpj,jpk)                        , STAT=ierr(5) ) 
    284 #endif 
    285  
     282         &      e3t_b   (jpi,jpj,jpk) , e3u_b(jpi,jpj,jpk) , e3v_b (jpi,jpj,jpk)                       , STAT=ierr(5) ) 
     283#endif 
     284         ! 
    286285      ALLOCATE( hu(jpi,jpj) , hur(jpi,jpj) , hu_0(jpi,jpj) ,     & 
    287286         &      hv(jpi,jpj) , hvr(jpi,jpj) , hv_0(jpi,jpj) , STAT=ierr(6) ) 
    288  
     287         ! 
    289288      ALLOCATE( gdept_0(jpk) , gdepw_0(jpk) ,                                     & 
    290289         &      e3t_0  (jpk) , e3w_0  (jpk) , e3tp (jpi,jpj), e3wp(jpi,jpj) ,     & 
    291290         &      gsigt  (jpk) , gsigw  (jpk) , gsi3w(jpk)    ,                     & 
    292291         &      esigt  (jpk) , esigw  (jpk)                                 , STAT=ierr(7) ) 
    293     ! 
     292         ! 
    294293      ALLOCATE( hbatv (jpi,jpj) , hbatf (jpi,jpj) ,     & 
    295294         &      hbatt (jpi,jpj) , hbatu (jpi,jpj) ,     & 
    … …  
    302301         &     mbkt   (jpi,jpj) , mbku (jpi,jpj) , mbkv(jpi,jpj) , STAT=ierr(9) ) 
    303302 
    304       ALLOCATE( tmask(jpi,jpj,jpk), umask(jpi,jpj,jpk),     &  
    305          &      vmask(jpi,jpj,jpk), fmask(jpi,jpj,jpk), STAT=ierr(10) ) 
     303      ALLOCATE( tmask(jpi,jpj,jpk) , umask(jpi,jpj,jpk),     &  
     304         &      vmask(jpi,jpj,jpk) , fmask(jpi,jpj,jpk), STAT=ierr(10) ) 
    306305 
    307306#if defined key_noslip_accurate 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DOM/domcfg.F90

    r2528 r2690  
    2424   !! NEMO/OPA 3.2 , LODYC-IPSL  (2009) 
    2525   !! $Id$  
    26    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     26   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    2727   !!---------------------------------------------------------------------- 
    28  
    2928CONTAINS 
    3029 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90

    r2651 r2690  
    126126      !!---------------------------------------------------------------------- 
    127127      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released, iwrk_in_use, iwrk_not_released 
    128       USE wrk_nemo, ONLY:   zwf => wrk_2d_1 
    129       USE wrk_nemo, ONLY:   imsk => iwrk_2d_1 
    130       !! 
     128      USE wrk_nemo, ONLY:   zwf  =>  wrk_2d_1      ! 2D real    workspace 
     129      USE wrk_nemo, ONLY:   imsk => iwrk_2d_1      ! 2D integer workspace 
     130      ! 
    131131      INTEGER  ::   ji, jj, jk      ! dummy loop indices 
    132       INTEGER  ::   iif, iil, ii0, ii1, ii 
    133       INTEGER  ::   ijf, ijl, ij0, ij1 
     132      INTEGER  ::   iif, iil, ii0, ii1, ii   ! local integers 
     133      INTEGER  ::   ijf, ijl, ij0, ij1       !   -       - 
    134134      !! 
    135135      NAMELIST/namlbc/ rn_shlat 
    136136      !!--------------------------------------------------------------------- 
    137137       
    138       IF( wrk_in_use(2, 1) .OR. iwrk_in_use(2, 1) )THEN 
    139          CALL ctl_stop('dom_msk: ERROR: requested workspace arrays unavailable')   ;   RETURN 
     138      IF( wrk_in_use(2, 1) .OR. iwrk_in_use(2, 1) ) THEN 
     139         CALL ctl_stop('dom_msk: requested workspace arrays unavailable')   ;   RETURN 
    140140      ENDIF 
    141141 
    … …  
    436436      ENDIF 
    437437      ! 
    438       IF( wrk_not_released(2, 1) .OR.   & 
    439          iwrk_not_released(2, 1)   )   CALL ctl_stop('dom_msk: ERROR: failed to release workspace arrays') 
     438      IF( wrk_not_released(2, 1)  .OR.   & 
     439         iwrk_not_released(2, 1)  )   CALL ctl_stop('dom_msk: failed to release workspace arrays') 
    440440      ! 
    441441   END SUBROUTINE dom_msk 
    … …  
    461461      !!--------------------------------------------------------------------- 
    462462 
    463       IF(lwp)WRITE(numout,*) 
    464       IF(lwp)WRITE(numout,*) 'dom_msk_nsa : noslip accurate boundary condition' 
    465       IF(lwp)WRITE(numout,*) '~~~~~~~~~~~   using Schchepetkin and O Brian scheme' 
     463      IF(lwp) WRITE(numout,*) 
     464      IF(lwp) WRITE(numout,*) 'dom_msk_nsa : noslip accurate boundary condition' 
     465      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   using Schchepetkin and O Brian scheme' 
    466466      IF( lk_mpp )   CALL ctl_stop( ' mpp version is not yet implemented' ) 
    467467 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DOM/domngb.F90

    r2636 r2690  
    88 
    99   !!---------------------------------------------------------------------- 
    10    !!   dom_ngb       : find the closest grid point from a given on/lat position 
     10   !!   dom_ngb       : find the closest grid point from a given lon/lat position 
    1111   !!---------------------------------------------------------------------- 
    12    USE dom_oce         ! ocean space and time domain 
    13    USE lib_mpp         ! for mppsum 
     12   USE dom_oce        ! ocean space and time domain 
     13   USE lib_mpp        ! for mppsum 
    1414 
    1515   IMPLICIT NONE 
    1616   PRIVATE 
    1717 
    18    PUBLIC   dom_ngb    ! routine called in iom.F90 module 
     18   PUBLIC   dom_ngb   ! routine called in iom.F90 module 
    1919 
    2020   !!---------------------------------------------------------------------- 
    … …  
    2929      !!                    ***  ROUTINE dom_ngb  *** 
    3030      !! 
    31       !! ** Purpose :   find the closest grid point from a given on/lat position 
     31      !! ** Purpose :   find the closest grid point from a given lon/lat position 
    3232      !! 
    3333      !! ** Method  :   look for minimum distance in cylindrical projection  
    3434      !!                -> not good if located at too high latitude... 
    35       !! 
    3635      !!---------------------------------------------------------------------- 
    37       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    38       USE wrk_nemo, ONLY: zglam => wrk_2d_2, & 
    39                           zgphi => wrk_2d_3, & 
    40                           zmask => wrk_2d_4, & 
    41                           zdist => wrk_2d_5 
    42       IMPLICIT none 
     36      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     37      USE wrk_nemo, ONLY:   zglam => wrk_2d_2 , zgphi => wrk_2d_3 , zmask => wrk_2d_4 , zdist => wrk_2d_5 
     38      ! 
    4339      REAL(wp)        , INTENT(in   ) ::   plon, plat   ! longitude,latitude of the point 
    4440      INTEGER         , INTENT(  out) ::   kii, kjj     ! i-,j-index of the closes grid point 
    4541      CHARACTER(len=1), INTENT(in   ) ::   cdgrid       ! grid name 'T', 'U', 'V', 'W' 
    46       !! 
    47       INTEGER , DIMENSION(2)        ::   iloc 
    48       REAL(wp)                      ::   zlon 
    49       REAL(wp)                      ::   zmini 
     42      ! 
     43      INTEGER , DIMENSION(2) ::   iloc 
     44      REAL(wp)               ::   zlon, zmini 
    5045      !!-------------------------------------------------------------------- 
    51  
    52       IF(wrk_in_use(2, 2, 3, 4, 5))THEN 
    53          CALL ctl_stop('dom_ngb: Requested workspaces already in use.') 
    54       END IF 
    55  
    56       zmask(:,:) = 0. 
     46      ! 
     47      IF( wrk_in_use(2, 2,3,4,5) )   CALL ctl_stop('dom_ngb: Requested workspaces already in use') 
     48      ! 
     49      zmask(:,:) = 0._wp 
    5750      SELECT CASE( cdgrid ) 
    5851      CASE( 'U' )  ; zglam(:,:) = glamu(:,:) ; zgphi(:,:) = gphiu(:,:) ; zmask(nldi:nlei,nldj:nlej) = umask(nldi:nlei,nldj:nlej,1) 
    … …  
    7871         kjj = iloc(2) + njmpp - 1 
    7972      ENDIF 
    80  
    81       IF(wrk_not_released(2, 2,3,4,5))THEN 
    82          CALL ctl_stop('dom_ngb: error releasing workspaces.') 
    83       ENDIF 
    84  
     73      ! 
     74      IF( wrk_not_released(2, 2,3,4,5) )   CALL ctl_stop('dom_ngb: error releasing workspaces') 
     75      ! 
    8576   END SUBROUTINE dom_ngb 
    8677 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DOM/domstp.F90

    r2636 r2690  
    5656      !!              - atfp1    : = 1 - 2*atfp 
    5757      !! 
    58       !! References : 
    59       !!      Bryan, K., 1984, J. Phys. Oceanogr., 14, 666-673. 
     58      !! References :   Bryan, K., 1984, J. Phys. Oceanogr., 14, 666-673. 
    6059      !!---------------------------------------------------------------------- 
    6160      INTEGER ::   jk              ! dummy loop indice 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90

    r2679 r2690  
    4848      !!---------------------------------------------------------------------- 
    4949      ! 
    50       ALLOCATE( mut (jpi,jpj,jpk) , muu (jpi,jpj,jpk) , muv (jpi,jpj,jpk) , muf (jpi,jpj,jpk) ,    & 
    51          &      ee_t(jpi,jpj)     , ee_u(jpi,jpj)     , ee_v(jpi,jpj)     , ee_f(jpi,jpj)     ,    & 
    52          &      r2dt(jpk)                                                                     , STAT=dom_vvl_alloc) 
     50      ALLOCATE( mut (jpi,jpj,jpk) , muu (jpi,jpj,jpk) , muv (jpi,jpj,jpk) , muf (jpi,jpj,jpk) ,     & 
     51         &      ee_t(jpi,jpj)     , ee_u(jpi,jpj)     , ee_v(jpi,jpj)     , ee_f(jpi,jpj)     ,     & 
     52         &      r2dt        (jpk)                                                             , STAT=dom_vvl_alloc ) 
    5353         ! 
    5454      IF( lk_mpp             )   CALL mpp_sum ( dom_vvl_alloc ) 
    … …  
    6666      !!---------------------------------------------------------------------- 
    6767      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    68       USE wrk_nemo, ONLY:   zs_t   => wrk_2d_1, zs_u_1 => wrk_2d_2 
    69       USE wrk_nemo, ONLY:   zs_v_1 => wrk_2d_3 
    70       !! 
    71       INTEGER  ::   ji, jj, jk 
     68      USE wrk_nemo, ONLY:   zs_t   => wrk_2d_1 , zs_u_1 => wrk_2d_2 , zs_v_1 => wrk_2d_3     ! 2D workspace 
     69      ! 
     70      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    7271      REAL(wp) ::   zcoefu , zcoefv   , zcoeff                   ! local scalars 
    7372      REAL(wp) ::   zv_t_ij, zv_t_ip1j, zv_t_ijp1, zv_t_ip1jp1   !   -      - 
    7473      !!---------------------------------------------------------------------- 
    7574 
    76       IF(wrk_in_use(2, 1,2,3))THEN 
    77          CALL ctl_stop('dom_vvl: ERROR - requested workspace arrays unavailable.')   ;   RETURN 
    78       END IF 
     75      IF( wrk_in_use(2, 1,2,3) ) THEN 
     76         CALL ctl_stop('dom_vvl: requested workspace arrays unavailable')   ;   RETURN 
     77      ENDIF 
    7978 
    8079      IF(lwp) THEN 
    … …  
    190189      fse3v_b(:,:,:) = fse3v_b(:,:,:) + fse3v_0(:,:,:) 
    191190      ! 
    192       IF(wrk_not_released(2, 1,2,3))THEN 
    193          CALL ctl_stop('dom_vvl: ERROR - failed to release workspace arrays.') 
    194       END IF 
     191      IF( wrk_not_released(2, 1,2,3) )   CALL ctl_stop('dom_vvl: failed to release workspace arrays') 
    195192      ! 
    196193   END SUBROUTINE dom_vvl 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90

    r2633 r2690  
    6363      !!                                   masks, depth and vertical scale factors 
    6464      !!---------------------------------------------------------------------- 
    65       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    66       USE wrk_nemo, ONLY: zprt  => wrk_2d_1, zprw  => wrk_2d_2 
    67       USE wrk_nemo, ONLY: zdepu => wrk_3d_1, zdepv => wrk_3d_2 
     65      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     66      USE wrk_nemo, ONLY:   zprt  => wrk_2d_1 , zprw  => wrk_2d_2    ! 2D workspace 
     67      USE wrk_nemo, ONLY:   zdepu => wrk_3d_1 , zdepv => wrk_3d_2    ! 3D     - 
    6868      !! 
    6969      INTEGER           ::   inum0    ! temprary units for 'mesh_mask.nc' file 
    … …  
    8181 
    8282      IF( wrk_in_use(2, 1,2) .OR. wrk_in_use(3, 1,2) )THEN 
    83          CALL ctl_stop('dom_wri: ERROR - requested workspace arrays unavailable.') 
    84          RETURN 
     83         CALL ctl_stop('dom_wri: requested workspace arrays unavailable')   ;   RETURN 
    8584      END IF 
    8685 
    … …  
    261260      END SELECT 
    262261      ! 
    263       IF( wrk_not_released(2, 1,2) .OR. wrk_not_released(3, 1,2) )THEN 
    264          CALL ctl_stop('dom_wri: ERROR - failed to release workspace arrays.') 
    265       END IF 
     262      IF( wrk_not_released(2, 1,2)  .OR.   & 
     263          wrk_not_released(3, 1,2)  )   CALL ctl_stop('dom_wri: failed to release workspace arrays') 
    266264      ! 
    267265   END SUBROUTINE dom_wri 
    … …  
    277275      !!                2) check which elements have been changed 
    278276      !!---------------------------------------------------------------------- 
    279       !! 
    280       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    281       USE wrk_nemo, ONLY: ztstref => wrk_2d_1      ! array with different values for each element 
    282      !! 
     277      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     278      USE wrk_nemo, ONLY:   ztstref => wrk_2d_1      ! array with different values for each element 
     279      ! 
    283280      CHARACTER(len=1)        , INTENT(in   ) ::   cdgrd   !  
    284281      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   puniq   !  
    … …  
    290287 
    291288      IF( wrk_in_use(2, 1) ) THEN 
    292          CALL ctl_stop('dom_uniq : requested workspace array unavailable.')   ;   RETURN 
    293          RETURN 
    294       END IF 
     289         CALL ctl_stop('dom_uniq: requested workspace array unavailable')   ;   RETURN 
     290      ENDIF 
    295291 
    296292      ! build an array with different values for each element  
    … …  
    308304      puniq(nldi:nlei,nldj:nlej) = REAL( COUNT( lldbl(nldi:nlei,nldj:nlej,:), dim = 3 ) , wp ) 
    309305      ! 
    310       IF( wrk_not_released(2, 1) ) THEN 
    311          CALL ctl_stop('dom_uniq : failed to release workspace array.')   ;   RETURN 
    312       END IF 
     306      IF( wrk_not_released(2, 1) )   CALL ctl_stop('dom_uniq: failed to release workspace array') 
    313307      ! 
    314308   END SUBROUTINE dom_uniq 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90

    r2683 r2690  
    615615      !!---------------------------------------------------------------------- 
    616616      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    617       USE wrk_nemo, ONLY:   zbathy => wrk_2d_1 
     617      USE wrk_nemo, ONLY:   zbathy => wrk_2d_1     ! 2D workspace 
    618618      !! 
    619619      INTEGER ::   ji, jj, jl                    ! dummy loop indices 
    … …  
    745745      !!---------------------------------------------------------------------- 
    746746      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    747       USE wrk_nemo, ONLY:   zmbk => wrk_2d_1 
     747      USE wrk_nemo, ONLY:   zmbk => wrk_2d_1    ! 2D workspace 
    748748      !! 
    749749      INTEGER ::   ji, jj   ! dummy loop indices 
    … …  
    848848      !!---------------------------------------------------------------------- 
    849849      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    850       USE wrk_nemo, ONLY:   zprt => wrk_3d_1 
     850      USE wrk_nemo, ONLY:   zprt => wrk_3d_1    ! 3D workspace 
    851851      !! 
    852852      INTEGER  ::   ji, jj, jk       ! dummy loop indices 
    … …  
    861861      !  
    862862      IF( wrk_in_use(3, 1) ) THEN 
    863          CALL ctl_stop('zgr_zps: requested workspace unavailable.')   ;   RETURN 
     863         CALL ctl_stop('zgr_zps: requested workspace unavailable')   ;   RETURN 
    864864      ENDIF 
    865865 
    … …  
    11421142      !!---------------------------------------------------------------------- 
    11431143      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    1144       USE wrk_nemo, ONLY:   zenv => wrk_2d_1 , ztmp => wrk_2d_2 , zmsk  => wrk_2d_3 
    1145       USE wrk_nemo, ONLY:   zri  => wrk_2d_4 , zrj  => wrk_2d_5 , zhbat => wrk_2d_6 
     1144      USE wrk_nemo, ONLY:   zenv => wrk_2d_1 , ztmp => wrk_2d_2 , zmsk  => wrk_2d_3    ! 2D workspace 
     1145      USE wrk_nemo, ONLY:   zri  => wrk_2d_4 , zrj  => wrk_2d_5 , zhbat => wrk_2d_6    !  -      - 
    11461146      ! 
    11471147      INTEGER  ::   ji, jj, jk, jl           ! dummy loop argument 
    … …  
    11531153 
    11541154      IF( wrk_in_use(2, 1,2,3,4,5,6) ) THEN 
    1155          CALL ctl_stop('zgr_sco: ERROR - requested workspace arrays unavailable')   ;   RETURN 
     1155         CALL ctl_stop('zgr_sco: requested workspace arrays unavailable')   ;   RETURN 
    11561156      ENDIF 
    11571157 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90

    r2636 r2690  
    446446      !!                 p=integral [ rau*g dz ] 
    447447      !!---------------------------------------------------------------------- 
    448       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    449       USE wrk_nemo, ONLY: zprn => wrk_3d_1 
     448      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     449      USE wrk_nemo, ONLY:   zprn => wrk_3d_1    ! 3D workspace 
    450450 
    451451      USE dynspg          ! surface pressure gradient             (dyn_spg routine) 
    … …  
    458458      !!---------------------------------------------------------------------- 
    459459 
    460       IF(wrk_in_use(3, 1))THEN 
    461          CALL ctl_stop('istage_uvg: requested workspace array unavailable.') 
    462          RETURN 
    463       END IF 
     460      IF(wrk_in_use(3, 1) ) THEN 
     461         CALL ctl_stop('istage_uvg: requested workspace array unavailable')   ;   RETURN 
     462      ENDIF 
    464463 
    465464      IF(lwp) WRITE(numout,*)  
    … …  
    558557      rotb (:,:,:) = rotn (:,:,:)       ! set the before to the now value 
    559558      ! 
    560       IF(wrk_not_released(3, 1))THEN 
    561          CALL ctl_stop('istage_uvg: failed to release workspace array.') 
    562       END IF 
     559      IF( wrk_not_released(3, 1) ) THEN 
     560         CALL ctl_stop('istage_uvg: failed to release workspace array') 
     561      ENDIF 
    563562      ! 
    564563   END SUBROUTINE istate_uvg 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90

    r2636 r2690  
    9797         IF(lwp) WRITE(numout,*) '~~~~~~~   NOT optimal for auto-tasking case' 
    9898         ! 
    99          ALLOCATE( zwu( jpi, 1:jpj+2) , zwv(-1:jpi+2, jpj) , Stat=ierr ) 
     99         ALLOCATE( zwu( jpi, 1:jpj+2) , zwv(-1:jpi+2, jpj) , STAT=ierr ) 
    100100         IF( lk_mpp    )   CALL mpp_sum( ierr ) 
    101101         IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'div_cur : unable to allocate arrays' ) 
    … …  
    273273      !!              - update rotb , rotn , the before & now rel. vorticity 
    274274      !!---------------------------------------------------------------------- 
    275       INTEGER, INTENT( in ) ::   kt     ! ocean time-step index 
    276       ! 
    277       INTEGER  ::   ji, jj, jk          ! dummy loop indices 
    278       REAL(wp) ::  zraur, zdep 
     275      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     276      ! 
     277      INTEGER  ::   ji, jj, jk    ! dummy loop indices 
     278      REAL(wp) ::   zraur, zdep   ! local scalars 
    279279      !!---------------------------------------------------------------------- 
    280280 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv.F90

    r2636 r2690  
    1313   !!---------------------------------------------------------------------- 
    1414   USE dom_oce         ! ocean space and time domain 
    15    USE in_out_manager  ! I/O manager 
    16    USE lib_mpp         ! MPP library 
    17  
    1815   USE dynadv_cen2     ! centred flux form advection      (dyn_adv_cen2 routine) 
    1916   USE dynadv_ubs      ! UBS flux form advection          (dyn_adv_ubs  routine) 
    2017   USE dynkeg          ! kinetic energy gradient          (dyn_keg      routine) 
    2118   USE dynzad          ! vertical advection               (dyn_zad      routine) 
     19   USE in_out_manager  ! I/O manager 
     20   USE lib_mpp         ! MPP library 
    2221 
    2322   IMPLICIT NONE 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_cen2.F90

    r2636 r2690  
    1818   USE trdmod         ! ocean dynamics trends 
    1919   USE in_out_manager ! I/O manager 
    20    USE lib_mpp         ! MPP library 
     20   USE lib_mpp        ! MPP library 
    2121   USE prtctl         ! Print control 
    2222 
    … …  
    4848      !!---------------------------------------------------------------------- 
    4949      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    50       USE oce     , ONLY:   zfu   => ta       ! use ta as 3D workspace 
    51       USE oce     , ONLY:   zfv   => sa       ! use sa as 3D workspace 
     50      USE oce     , ONLY:   zfu   => ta       , zfv   => sa       ! (ta,sa) used as 3D workspace 
    5251      USE wrk_nemo, ONLY:   zfu_t => wrk_3d_1 , zfv_t => wrk_3d_4 , zfu_uw =>wrk_3d_6   ! 3D workspaces 
    5352      USE wrk_nemo, ONLY:   zfu_f => wrk_3d_2 , zfv_f => wrk_3d_5 , zfv_vw =>wrk_3d_7 
    5453      USE wrk_nemo, ONLY:   zfw   => wrk_3d_3  
    55       !! 
     54      ! 
    5655      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    57       !! 
     56      ! 
    5857      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    59       REAL(wp) ::   zbu, zbv     ! temporary scalars 
     58      REAL(wp) ::   zbu, zbv     ! local scalars 
    6059      !!---------------------------------------------------------------------- 
    6160 
    … …  
    6968      IF( wrk_in_use(3, 1,2,3,4,5,6,7) ) THEN 
    7069         CALL ctl_stop('dyn_adv_cen2 : requested workspace array unavailable')   ;   RETURN 
    71       END IF 
     70      ENDIF 
    7271 
    7372      IF( l_trddyn ) THEN           ! Save ua and va trends 
    … …  
    163162         &                       tab3d_2=va, clinfo2=           ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    164163      ! 
    165       IF( wrk_not_released(3, 1,2,3,4,5,6,7) )   CALL ctl_stop('dyn_adv_cen2 : failed to release workspace array') 
     164      IF( wrk_not_released(3, 1,2,3,4,5,6,7) )   CALL ctl_stop('dyn_adv_cen2: failed to release workspace array') 
    166165      ! 
    167166   END SUBROUTINE dyn_adv_cen2 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_ubs.F90

    r2636 r2690  
    6969      !!---------------------------------------------------------------------- 
    7070      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    71       USE oce     , ONLY:   zfu    => ta       ! ta used as 3D workspace 
    72       USE oce     , ONLY:   zfv    => sa       ! sa used as 3D workspace 
     71      USE oce     , ONLY:   zfu    => ta       , zfv    => sa      ! (ta,sa) used as 3D workspace 
    7372      USE wrk_nemo, ONLY:   zfu_t  => wrk_3d_1 , zfv_t  =>wrk_3d_4 , zfu_uw =>wrk_3d_6   ! 3D workspace 
    7473      USE wrk_nemo, ONLY:   zfu_f  => wrk_3d_2 , zfv_f  =>wrk_3d_5 , zfv_vw =>wrk_3d_7 
    … …  
    9291      ! Check that required workspace arrays are not already in use 
    9392      IF( wrk_in_use(3, 1,2,3,4,5,6,7) .OR. wrk_in_use(4, 1,2,3,4) ) THEN 
    94          CALL ctl_stop('dyn_adv_ubs : requested workspace array unavailable')   ;   RETURN 
     93         CALL ctl_stop('dyn_adv_ubs: requested workspace array unavailable')   ;   RETURN 
    9594      ENDIF 
    9695 
    … …  
    255254         &                       tab3d_2=va, clinfo2=           ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    256255      ! 
    257       IF( wrk_not_released(3, 1,2,3,4,5,6,7) .OR. & 
    258           wrk_not_released(4, 1,2,3,4)        )   CALL ctl_stop('dyn_adv_ubs : failed to release workspace array') 
     256      IF( wrk_not_released(3, 1,2,3,4,5,6,7) .OR.   & 
     257          wrk_not_released(4, 1,2,3,4)       )   CALL ctl_stop('dyn_adv_ubs: failed to release workspace array') 
    259258      ! 
    260259   END SUBROUTINE dyn_adv_ubs 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynbfr.F90

    r2547 r2690  
    1313   USE dom_oce         ! ocean space and time domain variables  
    1414   USE zdf_oce         ! ocean vertical physics variables 
    15  
    1615   USE trdmod          ! ocean active dynamics and tracers trends  
    1716   USE trdmod_oce      ! ocean variables trends 
    … …  
    4342      !! ** Action  :   (ua,va)   momentum trend increased by bottom friction trend 
    4443      !!--------------------------------------------------------------------- 
    45       USE oce, ONLY :   ztrduv => tsa   ! use tsa as 4D workspace 
     44      USE oce, ONLY:   ztrduv => tsa   ! tsa used as 4D workspace 
    4645      !! 
    4746      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90

    r2636 r2690  
    3131   USE dom_oce         ! ocean space and time domain 
    3232   USE phycst          ! physical constants 
    33    USE in_out_manager  ! I/O manager 
    3433   USE trdmod          ! ocean dynamics trends  
    3534   USE trdmod_oce      ! ocean variables trends 
     35   USE in_out_manager  ! I/O manager 
    3636   USE prtctl          ! Print control 
    3737   USE lbclnk          ! lateral boundary condition  
    … …  
    7777      !!             - Save the trend (l_trddyn=T) 
    7878      !!---------------------------------------------------------------------- 
    79       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    80       USE wrk_nemo, ONLY: ztrdu => wrk_3d_1, ztrdv => wrk_3d_2   ! 3D workspace 
     79      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     80      USE wrk_nemo, ONLY:   ztrdu => wrk_3d_1 , ztrdv => wrk_3d_2   ! 3D workspace 
    8181      !! 
    8282      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    … …  
    193193      !! ** Action : - Update (ua,va) with the now hydrastatic pressure trend 
    194194      !!---------------------------------------------------------------------- 
    195       USE oce, ONLY :   zhpi => ta   ! use ta as 3D workspace 
    196       USE oce, ONLY :   zhpj => sa   ! use sa as 3D workspace 
     195      USE oce, ONLY:   zhpi => ta , zhpj => sa   ! (ta,sa) used as 3D workspace 
    197196      !! 
    198197      INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
    … …  
    208207      ENDIF 
    209208       
    210       ! Local constant initialization  
    211       zcoef0 = - grav * 0.5_wp 
     209      zcoef0 = - grav * 0.5_wp      ! Local constant initialization  
    212210 
    213211      ! Surface value 
    … …  
    255253      !! ** Action  : - Update (ua,va) with the now hydrastatic pressure trend 
    256254      !!----------------------------------------------------------------------  
    257       USE oce, ONLY :   zhpi => ta   ! use ta as 3D workspace 
    258       USE oce, ONLY :   zhpj => sa   ! use sa as 3D workspace 
     255      USE oce, ONLY:   zhpi => ta , zhpj => sa   ! (ta,sa) used as 3D workspace 
    259256      !! 
    260257      INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
    … …  
    357354      !! ** Action : - Update (ua,va) with the now hydrastatic pressure trend 
    358355      !!---------------------------------------------------------------------- 
    359       USE oce, ONLY :   zhpi => ta   ! use ta as 3D workspace 
    360       USE oce, ONLY :   zhpj => sa   ! use sa as 3D workspace 
     356      USE oce, ONLY:   zhpi => ta , zhpj => sa   ! (ta,sa) used as 3D workspace 
    361357      !! 
    362358      INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
    … …  
    443439      !!             - Save the trend (l_trddyn=T) 
    444440      !!---------------------------------------------------------------------- 
    445       USE oce, ONLY :   zhpi => ta   ! use ta as 3D workspace 
    446       USE oce, ONLY :   zhpj => sa   ! use sa as 3D workspace 
     441      USE oce, ONLY:   zhpi => ta , zhpj => sa   ! (ta,sa) used as 3D workspace 
    447442      !! 
    448443      INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
    … …  
    520515      !! Reference : Song, Mon. Wea. Rev., 126, 3213-3230, 1998. 
    521516      !!---------------------------------------------------------------------- 
    522       USE oce, ONLY :   zhpi => ta   ! use ta as 3D workspace 
    523       USE oce, ONLY :   zhpj => sa   ! use sa as 3D workspace 
     517      USE oce, ONLY:   zhpi => ta , zhpj => sa   ! (ta,sa) used as 3D workspace 
    524518      !! 
    525519      INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
    … …  
    600594      !! Reference: Shchepetkin and McWilliams, J. Geophys. Res., 108(C3), 3090, 2003 
    601595      !!---------------------------------------------------------------------- 
    602       USE oce, ONLY :   zhpi => ta   ! use ta as 3D workspace 
    603       USE oce, ONLY :   zhpj => sa   ! use sa as 3D workspace 
    604       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    605       USE wrk_nemo, ONLY: drhox => wrk_3d_1  , dzx => wrk_3d_2 
    606       USE wrk_nemo, ONLY: drhou => wrk_3d_3  , dzu => wrk_3d_4 , rho_i => wrk_3d_5 
    607       USE wrk_nemo, ONLY: drhoy => wrk_3d_6  , dzy => wrk_3d_7 
    608       USE wrk_nemo, ONLY: drhov => wrk_3d_8  , dzv => wrk_3d_9 , rho_j => wrk_3d_10 
    609       USE wrk_nemo, ONLY: drhoz => wrk_3d_11 , dzz => wrk_3d_12  
    610       USE wrk_nemo, ONLY: drhow => wrk_3d_13 , dzw => wrk_3d_14 
    611       USE wrk_nemo, ONLY: rho_k => wrk_3d_15 
     596      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     597      USE oce     , ONLY:   zhpi  => ta        , zhpj => sa       ! (ta,sa) used as 3D workspace 
     598      USE wrk_nemo, ONLY:   drhox => wrk_3d_1  , dzx  => wrk_3d_2 
     599      USE wrk_nemo, ONLY:   drhou => wrk_3d_3  , dzu  => wrk_3d_4 , rho_i => wrk_3d_5 
     600      USE wrk_nemo, ONLY:   drhoy => wrk_3d_6  , dzy  => wrk_3d_7 
     601      USE wrk_nemo, ONLY:   drhov => wrk_3d_8  , dzv  => wrk_3d_9 , rho_j => wrk_3d_10 
     602      USE wrk_nemo, ONLY:   drhoz => wrk_3d_11 , dzz  => wrk_3d_12  
     603      USE wrk_nemo, ONLY:   drhow => wrk_3d_13 , dzw  => wrk_3d_14 
     604      USE wrk_nemo, ONLY:   rho_k => wrk_3d_15 
    612605      !! 
    613606      INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
    … …  
    620613 
    621614      IF( wrk_in_use(3, 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15) ) THEN 
    622          CALL ctl_stop('dyn:hpg_djc : requested workspace arrays unavailable')   ;   RETURN 
     615         CALL ctl_stop('dyn:hpg_djc: requested workspace arrays unavailable')   ;   RETURN 
    623616      ENDIF 
    624617 
    … …  
    628621         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   s-coordinate case, density Jacobian with cubic polynomial scheme' 
    629622      ENDIF 
    630  
    631623 
    632624      ! Local constant initialization 
    … …  
    820812      ! 
    821813      IF( wrk_not_released(3, 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15) )   & 
    822          CALL ctl_stop('dyn:hpg_djc : failed to release workspace arrays') 
     814         CALL ctl_stop('dyn:hpg_djc: failed to release workspace arrays') 
    823815      ! 
    824816   END SUBROUTINE hpg_djc 
    … …  
    833825      !! Reference: Thiem & Berntsen, Ocean Modelling, In press, 2005. 
    834826      !!---------------------------------------------------------------------- 
    835       USE oce, ONLY :   zhpi => ta   ! use ta as 3D workspace 
    836       USE oce, ONLY :   zhpj => sa   ! use sa as 3D workspace 
    837       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    838       USE wrk_nemo, ONLY: zdistr  => wrk_2d_1 , zsina   => wrk_2d_2 , zcosa  => wrk_2d_3 
    839       USE wrk_nemo, ONLY: zhpiorg => wrk_3d_1 , zhpirot => wrk_3d_2 
    840       USE wrk_nemo, ONLY: zhpitra => wrk_3d_3 , zhpine  => wrk_3d_4 
    841       USE wrk_nemo, ONLY: zhpjorg => wrk_3d_5 , zhpjrot => wrk_3d_6 
    842       USE wrk_nemo, ONLY: zhpjtra => wrk_3d_7 , zhpjne  => wrk_3d_8 
     827      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     828      USE oce     , ONLY:   zhpi    => ta       , zhpj    => sa       ! (ta,sa) used as 3D workspace 
     829      USE wrk_nemo, ONLY:   zdistr  => wrk_2d_1 , zsina   => wrk_2d_2 , zcosa  => wrk_2d_3 
     830      USE wrk_nemo, ONLY:   zhpiorg => wrk_3d_1 , zhpirot => wrk_3d_2 
     831      USE wrk_nemo, ONLY:   zhpitra => wrk_3d_3 , zhpine  => wrk_3d_4 
     832      USE wrk_nemo, ONLY:   zhpjorg => wrk_3d_5 , zhpjrot => wrk_3d_6 
     833      USE wrk_nemo, ONLY:   zhpjtra => wrk_3d_7 , zhpjne  => wrk_3d_8 
    843834      !! 
    844835      INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
    … …  
    849840      !!---------------------------------------------------------------------- 
    850841 
    851       IF( wrk_in_use(2, 1,2,3) .OR.      & 
     842      IF( wrk_in_use(2, 1,2,3)             .OR.   & 
    852843          wrk_in_use(3, 1,2,3,4,5,6,7,8) ) THEN 
    853          CALL ctl_stop('dyn:hpg_rot : requested workspace arrays unavailable')   ;   RETURN 
    854       END IF 
     844         CALL ctl_stop('dyn:hpg_rot: requested workspace arrays unavailable')   ;   RETURN 
     845      ENDIF 
    855846 
    856847      IF( kt == nit000 ) THEN 
    … …  
    10091000      END DO 
    10101001      ! 
    1011       IF( wrk_not_released(2, 1,2,3)  .OR.     & 
    1012           wrk_not_released(3, 1,2,3,4,5,6,7,8) )   CALL ctl_stop('dyn:hpg_rot : failed to release workspace arrays') 
     1002      IF( wrk_not_released(2, 1,2,3)           .OR.   & 
     1003          wrk_not_released(3, 1,2,3,4,5,6,7,8) )   CALL ctl_stop('dyn:hpg_rot: failed to release workspace arrays') 
    10131004      ! 
    10141005   END SUBROUTINE hpg_rot 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf.F90

    r2636 r2690  
    5151      !! ** Purpose :   compute the lateral ocean dynamics physics. 
    5252      !!---------------------------------------------------------------------- 
    53       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    54       USE wrk_nemo, ONLY: ztrdu => wrk_3d_1, ztrdv => wrk_3d_2 
    55       !! 
     53      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     54      USE wrk_nemo, ONLY:   ztrdu => wrk_3d_1 , ztrdv => wrk_3d_2 
     55      ! 
    5656      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    5757      !!---------------------------------------------------------------------- 
    5858 
    5959      IF( wrk_in_use(3, 1,2) ) THEN 
    60          CALL ctl_stop('dyn_ldf: requested workspace arrays unavailable.')   ;   RETURN 
     60         CALL ctl_stop('dyn_ldf: requested workspace arrays unavailable')   ;   RETURN 
    6161      ENDIF 
    6262      ! 
    … …  
    110110         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    111111      ! 
    112       IF( wrk_not_released(3, 1,2) )   CALL ctl_stop('dyn_ldf: failed to release workspace arrays.') 
     112      IF( wrk_not_released(3, 1,2) )   CALL ctl_stop('dyn_ldf: failed to release workspace arrays') 
    113113      ! 
    114114   END SUBROUTINE dyn_ldf 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilap.F90

    r2636 r2690  
    7575      !!---------------------------------------------------------------------- 
    7676      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    77       USE wrk_nemo, ONLY:   zcu => wrk_2d_1, zcv => wrk_2d_2   ! 3D workspace 
    78       USE wrk_nemo, ONLY:   zuf => wrk_3d_1, zut => wrk_3d_2   ! 3D workspace 
    79       USE wrk_nemo, ONLY:   zlu => wrk_3d_3, zlv => wrk_3d_4 
     77      USE wrk_nemo, ONLY:   zcu => wrk_2d_1 , zcv => wrk_2d_2   ! 3D workspace 
     78      USE wrk_nemo, ONLY:   zuf => wrk_3d_1 , zut => wrk_3d_2   ! 3D workspace 
     79      USE wrk_nemo, ONLY:   zlu => wrk_3d_3 , zlv => wrk_3d_4 
    8080      ! 
    8181      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    8282      ! 
    83       INTEGER  ::   ji, jj, jk                ! dummy loop indices 
    84       REAL(wp) ::   zua, zva, zbt, ze2u, ze2v ! temporary scalar 
     83      INTEGER  ::   ji, jj, jk                  ! dummy loop indices 
     84      REAL(wp) ::   zua, zva, zbt, ze2u, ze2v   ! temporary scalar 
    8585      !!---------------------------------------------------------------------- 
    8686 
    … …  
    207207      END DO                                           !   End of slab 
    208208      !                                                ! =============== 
    209       IF( wrk_not_released(2, 1,2)      .OR.   & 
    210           wrk_not_released(3, 1,2,3,4) )   CALL ctl_stop('dyn_ldf_bilap : failed to release workspace arrays') 
     209      IF( wrk_not_released(2, 1,2)     .OR.   & 
     210          wrk_not_released(3, 1,2,3,4) )   CALL ctl_stop('dyn_ldf_bilap: failed to release workspace arrays') 
    211211      ! 
    212212   END SUBROUTINE dyn_ldf_bilap 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilapg.F90

    r2636 r2690  
    2020   USE ldfdyn_oce      ! ocean dynamics lateral physics 
    2121   USE zdf_oce         ! ocean vertical physics 
    22    USE in_out_manager  ! I/O manager 
    2322   USE trdmod          ! ocean dynamics trends  
    2423   USE trdmod_oce      ! ocean variables trends 
    2524   USE ldfslp          ! iso-neutral slopes available 
     25   USE in_out_manager  ! I/O manager 
    2626   USE lib_mpp         ! MPP library 
    2727   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    … …  
    5151      !!---------------------------------------------------------------------- 
    5252      ALLOCATE( zfuw(jpi,jpk) , zfvw (jpi,jpk) , zdiu(jpi,jpk) , zdiv (jpi,jpk) ,     & 
    53          &      zdju(jpi,jpk) , zdj1u(jpi,jpk) , zdjv(jpi,jpk) , zdj1v(jpi,jpk) , STAT=dyn_ldf_bilapg_alloc) 
     53         &      zdju(jpi,jpk) , zdj1u(jpi,jpk) , zdjv(jpi,jpk) , zdj1v(jpi,jpk) , STAT=dyn_ldf_bilapg_alloc ) 
    5454         ! 
    5555      IF( dyn_ldf_bilapg_alloc /= 0 )   CALL ctl_warn('dyn_ldf_bilapg_alloc: failed to allocate arrays') 
    … …  
    175175      !!      'key_trddyn' defined: the trend is saved for diagnostics. 
    176176      !!---------------------------------------------------------------------- 
    177       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    178       USE wrk_nemo, ONLY: ziut => wrk_2d_1, zjuf => wrk_2d_2, zjvt => wrk_2d_3 
    179       USE wrk_nemo, ONLY: zivf => wrk_2d_4, zdku => wrk_2d_5, zdk1u => wrk_2d_6 
    180       USE wrk_nemo, ONLY: zdkv => wrk_2d_7, zdk1v => wrk_2d_8 
     177      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     178      USE wrk_nemo, ONLY:   ziut => wrk_2d_1 , zjuf  => wrk_2d_2 , zjvt => wrk_2d_3 
     179      USE wrk_nemo, ONLY:   zivf => wrk_2d_4 , zdku  => wrk_2d_5 , zdk1u => wrk_2d_6 
     180      USE wrk_nemo, ONLY:   zdkv => wrk_2d_7 , zdk1v => wrk_2d_8 
    181181      !! 
    182182      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pu , pv    ! 1st call: before horizontal velocity  
    … …  
    195195 
    196196      IF( wrk_in_use(2, 1,2,3,4,5,6,7,8) ) THEN 
    197          CALL ctl_stop('dyn:ldfguv : requested workspace arrays unavailable.')   ;   RETURN 
     197         CALL ctl_stop('dyn:ldfguv: requested workspace arrays unavailable')   ;   RETURN 
    198198      END IF 
    199199      !                               ! ********** !   ! =============== 
    … …  
    452452      !                                                ! =============== 
    453453 
    454       IF( wrk_not_released(2, 1,2,3,4,5,6,7,8) )   CALL ctl_stop('dyn:ldfguv : failed to release workspace arrays') 
     454      IF( wrk_not_released(2, 1,2,3,4,5,6,7,8) )   CALL ctl_stop('dyn:ldfguv: failed to release workspace arrays') 
    455455      ! 
    456456   END SUBROUTINE ldfguv 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_iso.F90

    r2636 r2690  
    5555      !!---------------------------------------------------------------------- 
    5656      ALLOCATE( zfuw(jpi,jpk) , zdiu(jpi,jpk) , zdju(jpi,jpk) , zdj1u(jpi,jpk) ,     &  
    57          &      zfvw(jpi,jpk) , zdiv(jpi,jpk) , zdjv(jpi,jpk) , zdj1v(jpi,jpk) , STAT=dyn_ldf_iso_alloc) 
     57         &      zfvw(jpi,jpk) , zdiv(jpi,jpk) , zdjv(jpi,jpk) , zdj1v(jpi,jpk) , STAT=dyn_ldf_iso_alloc ) 
    5858         ! 
    5959      IF( dyn_ldf_iso_alloc /= 0 )   CALL ctl_warn('dyn_ldf_iso_alloc: array allocate failed.') 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_lap.F90

    r2528 r2690  
    44   !! Ocean dynamics:  lateral viscosity trend 
    55   !!====================================================================== 
     6   !! History :  OPA  ! 1990-09 (G. Madec) Original code 
     7   !!            4.0  ! 1991-11 (G. Madec) 
     8   !!            6.0  ! 1996-01 (G. Madec) statement function for e3 and ahm 
     9   !!   NEMO     1.0  ! 2002-06 (G. Madec)  F90: Free form and module 
     10   !!             -   ! 2004-08 (C. Talandier) New trends organization 
     11   !!---------------------------------------------------------------------- 
    612 
    713   !!---------------------------------------------------------------------- 
    … …  
    915   !!                  using an iso-level harmonic operator 
    1016   !!---------------------------------------------------------------------- 
    11    !! * Modules used 
    1217   USE oce             ! ocean dynamics and tracers 
    1318   USE dom_oce         ! ocean space and time domain 
    … …  
    2227   PRIVATE 
    2328 
    24    !! * Routine accessibility 
    2529   PUBLIC dyn_ldf_lap  ! called by step.F90 
    2630 
    … …  
    3236   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    3337   !! $Id$  
    34    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     38   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3539   !!---------------------------------------------------------------------- 
    36  
    3740CONTAINS 
    3841 
    … …  
    5861      !! ** Action : - Update (ua,va) with the before iso-level harmonic  
    5962      !!               mixing trend. 
    60       !! 
    61       !! History : 
    62       !!        !  90-09 (G. Madec) Original code 
    63       !!        !  91-11 (G. Madec) 
    64       !!        !  96-01 (G. Madec) statement function for e3 and ahm 
    65       !!   8.5  !  02-06 (G. Madec)  F90: Free form and module 
    66       !!   9.0  !  04-08 (C. Talandier) New trends organization 
    6763      !!---------------------------------------------------------------------- 
    68       !! * Arguments 
    69       INTEGER, INTENT( in ) ::   kt       ! ocean time-step index 
    70  
    71       !! * Local declarations 
    72       INTEGER  ::   ji, jj, jk            ! dummy loop indices 
    73       REAL(wp) ::   & 
    74          zua, zva, ze2u, ze1v             ! temporary scalars 
     64      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
     65      ! 
     66      INTEGER  ::   ji, jj, jk             ! dummy loop indices 
     67      REAL(wp) ::   zua, zva, ze2u, ze1v   ! local scalars 
    7568      !!---------------------------------------------------------------------- 
    76  
     69      ! 
    7770      IF( kt == nit000 ) THEN 
    7871         IF(lwp) WRITE(numout,*) 
    … …  
    8073         IF(lwp) WRITE(numout,*) '~~~~~~~ ' 
    8174      ENDIF 
    82  
    8375      !                                                ! =============== 
    8476      DO jk = 1, jpkm1                                 ! Horizontal slab 
    … …  
    8678         DO jj = 2, jpjm1 
    8779            DO ji = fs_2, fs_jpim1   ! vector opt. 
    88                ze2u = rotb (ji,jj,jk)*fsahmf(ji,jj,jk)*fse3f(ji,jj,jk) 
    89                ze1v = hdivb(ji,jj,jk)*fsahmt(ji,jj,jk) 
     80               ze2u = rotb (ji,jj,jk) * fsahmf(ji,jj,jk) * fse3f(ji,jj,jk) 
     81               ze1v = hdivb(ji,jj,jk) * fsahmt(ji,jj,jk) 
    9082               ! horizontal diffusive trends 
    9183               zua = - ( ze2u - rotb (ji,jj-1,jk)*fsahmf(ji,jj-1,jk)*fse3f(ji,jj-1,jk) ) / ( e2u(ji,jj) * fse3u(ji,jj,jk) )   & 
    … …  
    10395      END DO                                           !   End of slab 
    10496      !                                                ! =============== 
    105  
    10697   END SUBROUTINE dyn_ldf_lap 
    10798 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90

    r2636 r2690  
    5050   !! * Substitutions 
    5151#  include "domzgr_substitute.h90" 
    52    !!------------------------------------------------------------------------- 
     52   !!---------------------------------------------------------------------- 
    5353   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    5454   !! $Id$  
    55    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    56    !!------------------------------------------------------------------------- 
    57  
     55   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     56   !!---------------------------------------------------------------------- 
    5857CONTAINS 
    5958 
    … …  
    9291      !!               un,vn   now horizontal velocity of next time-step 
    9392      !!---------------------------------------------------------------------- 
    94       USE oce, ONLY :   ze3u_f => ta   ! use ta as 3D workspace 
    95       USE oce, ONLY :   ze3v_f => sa   ! use sa as 3D workspace 
    96       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    97       USE wrk_nemo, ONLY:   zs_t => wrk_2d_1, zs_u_1 => wrk_2d_2, & 
    98                           zs_v_1 => wrk_2d_3 
     93      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     94      USE oce     , ONLY:   ze3u_f => ta       , ze3v_f => sa       ! (ta,sa) used as 3D workspace 
     95      USE wrk_nemo, ONLY:   zs_t   => wrk_2d_1 , zs_u_1 => wrk_2d_2 , zs_v_1 => wrk_2d_3 
     96      ! 
    9997      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
    100       !! 
     98      ! 
    10199      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    102100#if ! defined key_dynspg_flt 
    103101      REAL(wp) ::   z2dt         ! temporary scalar 
    104102#endif 
    105       REAL(wp) ::   zue3a , zue3n , zue3b    ! temporary scalar 
    106       REAL(wp) ::   zve3a , zve3n , zve3b    !    -         - 
    107       REAL(wp) ::   zuf   , zvf              !    -         -  
    108       REAL(wp) ::   zec                      !    -         -  
    109       REAL(wp) ::   zv_t_ij  , zv_t_ip1j     !     -        - 
    110       REAL(wp) ::   zv_t_ijp1                !     -        - 
     103      REAL(wp) ::   zue3a, zue3n, zue3b, zuf    ! local scalars 
     104      REAL(wp) ::   zve3a, zve3n, zve3b, zvf    !   -      - 
     105      REAL(wp) ::   zec, zv_t_ij, zv_t_ip1j, zv_t_ijp1 
    111106      !!---------------------------------------------------------------------- 
    112107 
    … …  
    163158      CALL obc_dyn( kt ) 
    164159      ! 
    165       IF ( lk_dynspg_exp .OR. lk_dynspg_ts ) THEN 
     160      IF( .NOT. lk_dynspg_flt ) THEN 
    166161         ! Flather boundary condition : - Update sea surface height on each open boundary 
    167          !                                       sshn   (= after ssh   ) for explicit case 
    168          !                                       sshn_b (= after ssha_b) for time-splitting case 
     162         !                                       sshn   (= after ssh   ) for explicit case (lk_dynspg_exp=T) 
     163         !                                       sshn_b (= after ssha_b) for time-splitting case (lk_dynspg_ts=T) 
    169164         !                              - Correct the barotropic velocities 
    170165         CALL obc_dyn_bt( kt ) 
    … …  
    180175# elif defined key_bdy  
    181176      !                                !* BDY open boundaries 
    182       IF( lk_dynspg_exp .OR. lk_dynspg_ts ) THEN       ! except for filtered option 
    183          CALL bdy_dyn_frs( kt ) 
    184       ENDIF 
     177      IF( .NOT. lk_dynspg_flt )   CALL bdy_dyn_frs( kt ) 
    185178# endif 
    186179      ! 
    … …  
    325318         &                       tab3d_2=vn, clinfo2=' Vn: '       , mask2=vmask ) 
    326319      !  
    327       IF( wrk_not_released(2, 1,2,3) )   CALL ctl_stop('dyn_nxt: failed to release workspace arrays.') 
     320      IF( wrk_not_released(2, 1,2,3) )   CALL ctl_stop('dyn_nxt: failed to release workspace arrays') 
    328321      ! 
    329322   END SUBROUTINE dyn_nxt 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90

    r2676 r2690  
    7474      !!        of the physical meaning of the results.  
    7575      !!---------------------------------------------------------------------- 
    76       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    77       USE wrk_nemo, ONLY: ztrdu => wrk_3d_4, ztrdv => wrk_3d_5 
    78       !! 
     76      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     77      USE wrk_nemo, ONLY:   ztrdu => wrk_3d_4 , ztrdv => wrk_3d_5    ! 3D workspace 
     78      ! 
    7979      INTEGER, INTENT(in   ) ::   kt       ! ocean time-step index 
    8080      INTEGER, INTENT(  out) ::   kindic   ! solver flag 
    81       !! 
     81      ! 
    8282      INTEGER  ::   ji, jj, jk                             ! dummy loop indices 
    8383      REAL(wp) ::   z2dt, zg_2                             ! temporary scalar 
    … …  
    179179 
    180180      !                        ! allocate dyn_spg arrays 
    181       IF( lk_dynspg_ts .AND.dyn_spg_ts_alloc() /= 0 )   CALL ctl_stop('STOP', 'dyn_spg_init: failed to allocate ts  arrays') 
     181      IF( lk_dynspg_ts ) THEN 
     182         IF( dynspg_oce_alloc() /= 0 )   CALL ctl_stop('STOP', 'dyn_spg_init: failed to allocate dynspg_oce arrays') 
     183         IF( dyn_spg_ts_alloc() /= 0 )   CALL ctl_stop('STOP', 'dyn_spg_init: failed to allocate dynspg_ts  arrays') 
     184      ENDIF 
    182185 
    183186      !                        ! Control of surface pressure gradient scheme options 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_exp.F90

    r2618 r2690  
    4040   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    4141   !! $Id$ 
    42    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     42   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4343   !!---------------------------------------------------------------------- 
    4444CONTAINS 
    … …  
    6161      !!                         the surf. pressure gradient trend 
    6262      !!--------------------------------------------------------------------- 
    63       INTEGER, INTENT( in )  ::   kt         ! ocean time-step index 
     63      INTEGER, INTENT(in)  ::   kt   ! ocean time-step index 
    6464      !! 
    65       INTEGER  ::   ji, jj, jk               ! dummy loop indices 
     65      INTEGER ::   ji, jj, jk   ! dummy loop indices 
    6666      !!---------------------------------------------------------------------- 
    6767 
    … …  
    7171         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   (explicit free surface)' 
    7272         ! 
    73          spgu(:,:) = 0.e0   ;   spgv(:,:) = 0.e0 
     73         spgu(:,:) = 0._wp   ;   spgv(:,:) = 0._wp 
    7474         ! 
    7575         IF( lk_vvl .AND. lwp ) WRITE(numout,*) '              lk_vvl=T : spg is included in dynhpg' 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90

    r2674 r2690  
    6262   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    6363   !! $Id$ 
    64    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     64   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    6565   !!---------------------------------------------------------------------- 
    6666CONTAINS 
    … …  
    103103      !! References : Roullet and Madec 1999, JGR. 
    104104      !!--------------------------------------------------------------------- 
    105       USE oce, ONLY :   zub   => ta   ! ta used as workspace 
    106       USE oce, ONLY :   zvb   => sa   ! ta used as workspace 
     105      USE oce, ONLY:   zub   => ta , zvb   => sa   ! (ta,sa) used as workspace 
    107106      !! 
    108107      INTEGER, INTENT(in   ) ::   kt       ! ocean time-step index 
    109108      INTEGER, INTENT(  out) ::   kindic   ! solver convergence flag (<0 if not converge) 
    110109      !!                                    
    111       INTEGER  ::   ji, jj, jk           ! dummy loop indices 
    112       REAL(wp) ::   z2dt, z2dtg          ! temporary scalars 
    113       REAL(wp) ::   zgcb, zbtd   !   -          - 
    114       REAL(wp) ::   ztdgu, ztdgv         !   -          - 
     110      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     111      REAL(wp) ::   z2dt, z2dtg, zgcb, zbtd, ztdgu, ztdgv   ! local scalars 
    115112      !!---------------------------------------------------------------------- 
    116113      ! 
    … …  
    121118        
    122119         ! set to zero free surface specific arrays 
    123          spgu(:,:) = 0.e0                     ! surface pressure gradient (i-direction) 
    124          spgv(:,:) = 0.e0                     ! surface pressure gradient (j-direction) 
     120         spgu(:,:) = 0._wp                     ! surface pressure gradient (i-direction) 
     121         spgv(:,:) = 0._wp                     ! surface pressure gradient (j-direction) 
    125122 
    126123         ! read filtered free surface arrays in restart file 
    … …  
    202199      DO jj = 2, jpjm1 
    203200         DO ji = fs_2, fs_jpim1   ! vector opt. 
    204             spgu(ji,jj) = 0.e0 
    205             spgv(ji,jj) = 0.e0 
     201            spgu(ji,jj) = 0._wp 
     202            spgv(ji,jj) = 0._wp 
    206203         END DO 
    207204      END DO 
    … …  
    279276      ncut = 0 
    280277      ! if rnorme is 0, the solution is 0, the solver is not called 
    281       IF( rnorme == 0.e0 ) THEN 
    282          gcx(:,:) = 0.e0 
    283          res   = 0.e0 
     278      IF( rnorme == 0._wp ) THEN 
     279         gcx(:,:) = 0._wp 
     280         res   = 0._wp 
    284281         niter = 0 
    285282         ncut  = 999 
    … …  
    353350 
    354351   SUBROUTINE flt_rst( kt, cdrw ) 
    355      !!--------------------------------------------------------------------- 
    356      !!                   ***  ROUTINE ts_rst  *** 
    357      !! 
    358      !! ** Purpose : Read or write filtered free surface arrays in restart file 
    359      !!---------------------------------------------------------------------- 
    360      INTEGER         , INTENT(in) ::   kt         ! ocean time-step 
    361      CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag 
    362      !!---------------------------------------------------------------------- 
    363  
    364      IF( TRIM(cdrw) == 'READ' ) THEN 
    365         IF( iom_varid( numror, 'gcx', ldstop = .FALSE. ) > 0 ) THEN 
     352      !!--------------------------------------------------------------------- 
     353      !!                   ***  ROUTINE ts_rst  *** 
     354      !! 
     355      !! ** Purpose : Read or write filtered free surface arrays in restart file 
     356      !!---------------------------------------------------------------------- 
     357      INTEGER         , INTENT(in) ::   kt         ! ocean time-step 
     358      CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag 
     359      !!---------------------------------------------------------------------- 
     360      ! 
     361      IF( TRIM(cdrw) == 'READ' ) THEN 
     362         IF( iom_varid( numror, 'gcx', ldstop = .FALSE. ) > 0 ) THEN 
    366363! Caution : extra-hallow 
    367364! gcx and gcxb are defined as: DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj) 
    368            CALL iom_get( numror, jpdom_autoglo, 'gcx' , gcx (1:jpi,1:jpj) ) 
    369            CALL iom_get( numror, jpdom_autoglo, 'gcxb', gcxb(1:jpi,1:jpj) ) 
    370            IF( neuler == 0 )   gcxb(:,:) = gcx (:,:) 
    371         ELSE 
    372            gcx (:,:) = 0.e0 
    373            gcxb(:,:) = 0.e0 
    374         ENDIF 
    375      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN 
     365            CALL iom_get( numror, jpdom_autoglo, 'gcx' , gcx (1:jpi,1:jpj) ) 
     366            CALL iom_get( numror, jpdom_autoglo, 'gcxb', gcxb(1:jpi,1:jpj) ) 
     367            IF( neuler == 0 )   gcxb(:,:) = gcx (:,:) 
     368         ELSE 
     369            gcx (:,:) = 0.e0 
     370            gcxb(:,:) = 0.e0 
     371         ENDIF 
     372      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN 
    376373! Caution : extra-hallow 
    377374! gcx and gcxb are defined as: DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj) 
    378         CALL iom_rstput( kt, nitrst, numrow, 'gcx' , gcx (1:jpi,1:jpj) ) 
    379         CALL iom_rstput( kt, nitrst, numrow, 'gcxb', gcxb(1:jpi,1:jpj) ) 
    380      ENDIF 
    381      ! 
     375         CALL iom_rstput( kt, nitrst, numrow, 'gcx' , gcx (1:jpi,1:jpj) ) 
     376         CALL iom_rstput( kt, nitrst, numrow, 'gcxb', gcxb(1:jpi,1:jpj) ) 
     377      ENDIF 
     378      ! 
    382379   END SUBROUTINE flt_rst 
    383380 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90

    r2636 r2690  
    55   !!                 planetary vorticity trends 
    66   !!====================================================================== 
    7    !! History :  OPA  !  1989-12  (P. Andrich)  vor_ens: Original code 
    8    !!            5.0  !  1991-11  (G. Madec) vor_ene, vor_mix: Original code 
    9    !!            6.0  !  1996-01  (G. Madec)  s-coord, suppress work arrays 
    10    !!            8.5  ! 2002-08  (G. Madec)  F90: Free form and module 
    11    !!   NEMO     1.0  ! 2004-02  (G. Madec)  vor_een: Original code 
    12    !!             -   !  2003-08  (G. Madec)  add vor_ctl 
    13    !!             -   !  2005-11  (G. Madec)  add dyn_vor (new step architecture) 
    14    !!            2.0  !  2006-11  (G. Madec)  flux form advection: add metric term 
    15    !!            3.2  !  2009-04  (R. Benshila)  vvl: correction of een scheme 
    16    !!            3.3  !  2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase 
     7   !! History :  OPA  ! 1989-12  (P. Andrich)  vor_ens: Original code 
     8   !!            5.0  ! 1991-11  (G. Madec) vor_ene, vor_mix: Original code 
     9   !!            6.0  ! 1996-01  (G. Madec)  s-coord, suppress work arrays 
     10   !!   NEMO     0.5  ! 2002-08  (G. Madec)  F90: Free form and module 
     11   !!            1.0  ! 2004-02  (G. Madec)  vor_een: Original code 
     12   !!             -   ! 2003-08  (G. Madec)  add vor_ctl 
     13   !!             -   ! 2005-11  (G. Madec)  add dyn_vor (new step architecture) 
     14   !!            2.0  ! 2006-11  (G. Madec)  flux form advection: add metric term 
     15   !!            3.2  ! 2009-04  (R. Benshila)  vvl: correction of een scheme 
     16   !!            3.3  ! 2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase 
    1717   !!---------------------------------------------------------------------- 
    1818 
    … …  
    5858   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    5959   !! $Id$ 
    60    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     60   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    6161   !!---------------------------------------------------------------------- 
    6262CONTAINS 
    … …  
    7171      !!               and planetary vorticity trends) ('key_trddyn') 
    7272      !!---------------------------------------------------------------------- 
    73       USE oce, ONLY :   ztrdu => ta   ! use ta as 3D workspace 
    74       USE oce, ONLY :   ztrdv => sa   ! use sa as 3D workspace 
    75       !! 
     73      USE oce, ONLY:   ztrdu => ta , ztrdv => sa   ! (ta,sa) used as 3D workspace 
     74      ! 
    7675      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    7776      !!---------------------------------------------------------------------- 
    78  
     77      ! 
    7978      !                                          ! vorticity term  
    8079      SELECT CASE ( nvor )                       ! compute the vorticity trend and add it to the general trend 
    … …  
    171170         ! 
    172171      END SELECT 
    173  
     172      ! 
    174173      !                       ! print sum trends (used for debugging) 
    175       IF(ln_ctl) CALL prt_ctl( tab3d_1=ua, clinfo1=' vor  - Ua: ', mask1=umask, & 
     174      IF(ln_ctl) CALL prt_ctl( tab3d_1=ua, clinfo1=' vor  - Ua: ', mask1=umask,               & 
    176175         &                     tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    177176      ! 
    … …  
    205204      !! References : Sadourny, r., 1975, j. atmos. sciences, 32, 680-689. 
    206205      !!---------------------------------------------------------------------- 
    207       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    208       USE wrk_nemo, ONLY: zwx => wrk_2d_1, zwy => wrk_2d_2, zwz => wrk_2d_3 
    209       !! 
     206      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     207      USE wrk_nemo, ONLY:   zwx => wrk_2d_1 , zwy => wrk_2d_2 , zwz => wrk_2d_3     ! 2D workspace 
     208      ! 
    210209      INTEGER , INTENT(in   )                         ::   kt     ! ocean time-step index 
    211210      INTEGER , INTENT(in   )                         ::   kvor   ! =ncor (planetary) ; =ntot (total) ; 
    … …  
    213212      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pua    ! total u-trend 
    214213      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pva    ! total v-trend 
    215       !! 
    216       INTEGER  ::   ji, jj, jk         ! dummy loop indices 
    217       REAL(wp) ::   zx1, zy1, zfact2   ! temporary scalars 
    218       REAL(wp) ::   zx2, zy2           !    "         " 
     214      ! 
     215      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     216      REAL(wp) ::   zx1, zy1, zfact2, zx2, zy2   ! local scalars 
    219217      !!---------------------------------------------------------------------- 
    220218 
    … …  
    286284      END DO                                           !   End of slab 
    287285      !                                                ! =============== 
    288       IF( wrk_not_released(2, 1,2,3) )   CALL ctl_stop('dyn:vor_ene: failed to release workspace arrays.') 
     286      IF( wrk_not_released(2, 1,2,3) )   CALL ctl_stop('dyn:vor_ene: failed to release workspace arrays') 
    289287      ! 
    290288   END SUBROUTINE vor_ene 
    … …  
    322320      !! References : Sadourny, r., 1975, j. atmos. sciences, 32, 680-689. 
    323321      !!---------------------------------------------------------------------- 
    324       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    325       USE wrk_nemo, ONLY: zwx => wrk_2d_4, zwy => wrk_2d_5, & 
    326                           zwz => wrk_2d_6, zww => wrk_2d_7 
    327       !! 
     322      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     323      USE wrk_nemo, ONLY:   zwx => wrk_2d_4 , zwy => wrk_2d_5 , zwz => wrk_2d_6 , zww => wrk_2d_7   ! 2D workspace 
     324      ! 
    328325      INTEGER, INTENT(in) ::   kt   ! ocean timestep index 
    329       !! 
     326      ! 
    330327      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    331       REAL(wp) ::   zfact1, zua, zcua, zx1, zy1   ! temporary scalars 
    332       REAL(wp) ::   zfact2, zva, zcva, zx2, zy2   !    "         " 
     328      REAL(wp) ::   zfact1, zua, zcua, zx1, zy1   ! local scalars 
     329      REAL(wp) ::   zfact2, zva, zcva, zx2, zy2   !   -      - 
    333330      !!---------------------------------------------------------------------- 
    334331 
    … …  
    438435      !! References : Sadourny, r., 1975, j. atmos. sciences, 32, 680-689. 
    439436      !!---------------------------------------------------------------------- 
    440       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    441       USE wrk_nemo, ONLY: zwx => wrk_2d_4, zwy => wrk_2d_5, zwz => wrk_2d_6 
    442       !! 
     437      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     438      USE wrk_nemo, ONLY:   zwx => wrk_2d_4, zwy => wrk_2d_5, zwz => wrk_2d_6    ! 2D workspace 
     439      ! 
    443440      INTEGER , INTENT(in   )                         ::   kt     ! ocean time-step index 
    444441      INTEGER , INTENT(in   )                         ::   kvor   ! =ncor (planetary) ; =ntot (total) ; 
    … …  
    446443      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pua    ! total u-trend 
    447444      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pva    ! total v-trend 
    448       !! 
     445      ! 
    449446      INTEGER  ::   ji, jj, jk           ! dummy loop indices 
    450447      REAL(wp) ::   zfact1, zuav, zvau   ! temporary scalars 
    … …  
    452449       
    453450      IF( wrk_in_use(2, 4,5,6) ) THEN 
    454          CALL ctl_stop('dyn:vor_ens : requested workspace arrays unavailable')   ;   RETURN 
     451         CALL ctl_stop('dyn:vor_ens: requested workspace arrays unavailable')   ;   RETURN 
    455452      END IF 
    456453 
    … …  
    526523      END DO                                           !   End of slab 
    527524      !                                                ! =============== 
    528       IF( wrk_not_released(2, 4,5,6) )   CALL ctl_stop('dyn:vor_ens : failed to release workspace arrays') 
     525      IF( wrk_not_released(2, 4,5,6) )   CALL ctl_stop('dyn:vor_ens: failed to release workspace arrays') 
    529526      ! 
    530527   END SUBROUTINE vor_ens 
    … …  
    551548      !!---------------------------------------------------------------------- 
    552549      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    553       USE wrk_nemo, ONLY:   zwx  => wrk_2d_1 , zwy  => wrk_2d_2 ,  zwz => wrk_2d_3  
     550      USE wrk_nemo, ONLY:   zwx  => wrk_2d_1 , zwy  => wrk_2d_2 ,  zwz => wrk_2d_3     ! 2D workspace 
    554551      USE wrk_nemo, ONLY:   ztnw => wrk_2d_4 , ztne => wrk_2d_5  
    555552      USE wrk_nemo, ONLY:   ztsw => wrk_2d_6 , ztse => wrk_2d_7 
    556553#if defined key_vvl 
    557       USE wrk_nemo, ONLY:   ze3f => wrk_3d_1 
     554      USE wrk_nemo, ONLY:   ze3f => wrk_3d_1                                           ! 3D workspace (lk_vvl=T) 
    558555#endif 
    559556      ! 
    … …  
    568565      REAL(wp) ::   zfac12, zua, zva   ! local scalars 
    569566#if ! defined key_vvl 
    570       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), SAVE ::   ze3f 
     567      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), SAVE ::   ze3f     ! lk_vvl=F, ze3f=1/e3f saved one for all 
    571568#endif 
    572569      !!---------------------------------------------------------------------- 
    573570 
    574571      IF( wrk_in_use(2, 1,2,3,4,5,6,7) .OR. wrk_in_use(3, 1) ) THEN 
    575          CALL ctl_stop('dyn:vor_een : requested workspace arrays unavailable.')   ;   RETURN 
     572         CALL ctl_stop('dyn:vor_een: requested workspace arrays unavailable')   ;   RETURN 
    576573      ENDIF 
    577574 
    … …  
    593590                  ze3f(ji,jj,jk) = ( fse3t(ji,jj+1,jk)*tmask(ji,jj+1,jk) + fse3t(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk)   & 
    594591                     &             + fse3t(ji,jj  ,jk)*tmask(ji,jj  ,jk) + fse3t(ji+1,jj  ,jk)*tmask(ji+1,jj  ,jk) ) * 0.25 
    595                   IF( ze3f(ji,jj,jk) /= 0.e0 )   ze3f(ji,jj,jk) = 1.e0 / ze3f(ji,jj,jk) 
     592                  IF( ze3f(ji,jj,jk) /= 0._wp )   ze3f(ji,jj,jk) = 1._wp / ze3f(ji,jj,jk) 
    596593               END DO 
    597594            END DO 
    … …  
    600597      ENDIF 
    601598 
    602       zfac12 = 1.e0 / 12.e0      ! Local constant initialization 
     599      zfac12 = 1._wp / 12._wp    ! Local constant initialization 
    603600 
    604601       
    … …  
    673670      END DO                                           !   End of slab 
    674671      !                                                ! =============== 
    675       IF(wrk_not_released(2, 1,2,3,4,5,6,7) .OR.   & 
    676          wrk_not_released(3, 1)  )   CALL ctl_stop('dyn:vor_een : failed to release workspace arrays') 
     672      IF( wrk_not_released(2, 1,2,3,4,5,6,7) .OR.   & 
     673          wrk_not_released(3, 1)             )   CALL ctl_stop('dyn:vor_een: failed to release workspace arrays') 
    677674      ! 
    678675   END SUBROUTINE vor_een 
    … …  
    686683      !!              tracer advection schemes 
    687684      !!---------------------------------------------------------------------- 
    688       INTEGER ::   ioptio          ! temporary integer 
     685      INTEGER ::   ioptio          ! local integer 
     686      !! 
    689687      NAMELIST/namdyn_vor/ ln_dynvor_ens, ln_dynvor_ene, ln_dynvor_mix, ln_dynvor_een 
    690688      !!---------------------------------------------------------------------- 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynzad.F90

    r2636 r2690  
    44   !! Ocean dynamics : vertical advection trend 
    55   !!====================================================================== 
    6    !! History :  6.0  !  91-01  (G. Madec) Original code 
    7    !!            7.0  !  91-11  (G. Madec) 
    8    !!            7.5  !  96-01  (G. Madec) statement function for e3 
    9    !!            8.5  !  02-07  (G. Madec) j-k-i case: Original code 
    10    !!            8.5  !  02-07  (G. Madec) Free form, F90 
     6   !! History :  OPA  ! 1991-01  (G. Madec) Original code 
     7   !!            7.0  ! 1991-11  (G. Madec) 
     8   !!            7.5  ! 1996-01  (G. Madec) statement function for e3 
     9   !!   NEMO     0.5  ! 2002-07  (G. Madec) Free form, F90 
    1110   !!---------------------------------------------------------------------- 
    1211    
    … …  
    3433   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    3534   !! $Id$ 
    36    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     35   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3736   !!---------------------------------------------------------------------- 
    38  
    3937CONTAINS 
    4038 
    … …  
    5553      !!              - Save the trends in (ztrdu,ztrdv) ('key_trddyn') 
    5654     !!---------------------------------------------------------------------- 
    57       USE oce, ONLY:   zwuw => ta   ! use ta as 3D workspace 
    58       USE oce, ONLY:   zwvw => sa   ! use sa as 3D workspace 
    5955      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    60       USE wrk_nemo, ONLY: zww => wrk_2d_1 
    61       USE wrk_nemo, ONLY: ztrdu => wrk_3d_1, ztrdv => wrk_3d_2 
    62       !! 
     56      USE wrk_nemo, ONLY:   zww   => wrk_2d_1                        ! 2D workspace 
     57      USE oce     , ONLY:   zwuw  => ta       , zwvw  => sa          ! (ta,sa) used as 3D workspace 
     58      USE wrk_nemo, ONLY:   ztrdu => wrk_3d_1 , ztrdv => wrk_3d_2    ! 3D workspace 
     59      ! 
    6360      INTEGER, INTENT(in) ::   kt   ! ocean time-step inedx 
    64       !! 
     61      ! 
    6562      INTEGER  ::   ji, jj, jk      ! dummy loop indices 
    6663      REAL(wp) ::   zua, zva        ! temporary scalars 
    6764      !!---------------------------------------------------------------------- 
    6865       
    69       IF( wrk_in_use(2, 1)     .OR.    & 
    70           wrk_in_use(3, 1,2) ) THEN 
     66      IF( wrk_in_use(2, 1) .OR. wrk_in_use(3, 1,2) ) THEN 
    7167         CALL ctl_stop('dyn_zad: requested workspace arrays unavailable')   ;   RETURN 
    72       END IF 
     68      ENDIF 
    7369 
    7470      IF( kt == nit000 ) THEN 
    … …  
    126122         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    127123      ! 
    128       IF( wrk_not_released(2, 1)       .OR.    & 
     124      IF( wrk_not_released(2, 1)   .OR.   & 
    129125          wrk_not_released(3, 1,2) )   CALL ctl_stop('dyn_zad: failed to release workspace arrays') 
    130126      ! 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf.F90

    r2636 r2690  
    5353      !! ** Purpose :   compute the vertical ocean dynamics physics. 
    5454      !!--------------------------------------------------------------------- 
    55       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    56       USE wrk_nemo, ONLY: ztrdu => wrk_3d_1, ztrdv => wrk_3d_2 
     55      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     56      USE wrk_nemo, ONLY:   ztrdu => wrk_3d_1 , ztrdv => wrk_3d_2    ! 3D workspace 
    5757      !! 
    5858      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
    5959      !!--------------------------------------------------------------------- 
    6060 
    61       IF(wrk_in_use(3, 1,2))THEN 
    62          CALL ctl_stop('dyn_zdf: requested workspace arrays unavailable.') 
    63          RETURN 
     61      IF( wrk_in_use(3, 1,2) ) THEN 
     62         CALL ctl_stop('dyn_zdf: requested workspace arrays unavailable')   ;   RETURN 
    6463      END IF 
    6564      !                                          ! set time step 
    … …  
    7877      CASE ( 1 )   ;   CALL dyn_zdf_imp( kt, r2dt )      ! implicit scheme 
    7978      ! 
    80       CASE ( -1 )                                      ! esopa: test all possibility with control print 
     79      CASE ( -1 )                                        ! esopa: test all possibility with control print 
    8180                       CALL dyn_zdf_exp( kt, r2dt ) 
    8281                       CALL prt_ctl( tab3d_1=ua, clinfo1=' zdf0 - Ua: ', mask1=umask,               & 
    83             &                        tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
     82                          &          tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    8483                       CALL dyn_zdf_imp( kt, r2dt ) 
    8584                       CALL prt_ctl( tab3d_1=ua, clinfo1=' zdf1 - Ua: ', mask1=umask,               & 
    86             &                        tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
     85                          &          tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    8786      END SELECT 
    8887 
    … …  
    9695            &                    tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    9796      ! 
    98       IF(wrk_not_released(3, 1,2))THEN 
    99          CALL ctl_stop('dyn_zdf: failed to release workspace arrays.') 
    100       END IF 
     97      IF( wrk_not_released(3, 1,2) )   CALL ctl_stop('dyn_zdf: failed to release workspace arrays') 
    10198      ! 
    10299   END SUBROUTINE dyn_zdf 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_exp.F90

    r2636 r2690  
    66   !! History :  OPA  !  1990-10  (B. Blanke)  Original code 
    77   !!            8.0  !  1997-05  (G. Madec)  vertical component of isopycnal 
    8    !!   NEMO     1.0  !  1002-08  (G. Madec)  F90: Free form and module 
     8   !!   NEMO     0.5  !  2002-08  (G. Madec)  F90: Free form and module 
    99   !!            3.3  !  2010-04  (M. Leclair, G. Madec)  Forcing averaged over 2 time steps 
    1010   !!---------------------------------------------------------------------- 
    … …  
    5555      !!--------------------------------------------------------------------- 
    5656      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    57       USE oce     , ONLY :  zwx => ta       , zwy => sa         ! (ta,sa) used as 3D workspace 
     57      USE oce     , ONLY:   zwx => ta       , zwy => sa         ! (ta,sa) used as 3D workspace 
    5858      USE wrk_nemo, ONLY:   zwz => wrk_3d_1 , zww => wrk_3d_2   ! 3D workspace 
    5959      ! 
    … …  
    6161      REAL(wp), INTENT(in) ::   p2dt   ! time-step  
    6262      ! 
    63       INTEGER ::   ji, jj, jk, jl                            ! dummy loop indices 
    64       REAL(wp) ::   zrau0r, zlavmr, zua, zva                 ! temporary scalars 
     63      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices 
     64      REAL(wp) ::   zrau0r, zlavmr, zua, zva   ! local scalars 
    6565      !!---------------------------------------------------------------------- 
    6666 
    … …  
    120120      END DO                           ! End of time splitting 
    121121      ! 
    122       IF( wrk_not_released(3, 1,2) )   CALL ctl_stop('dyn_zdf_exp : failed to release workspace arrays') 
     122      IF( wrk_not_released(3, 1,2) )   CALL ctl_stop('dyn_zdf_exp: failed to release workspace arrays') 
    123123      ! 
    124124   END SUBROUTINE dyn_zdf_exp 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90

    r2636 r2690  
    11MODULE dynzdf_imp 
    2    !!============================================================================== 
     2   !!====================================================================== 
    33   !!                    ***  MODULE  dynzdf_imp  *** 
    44   !! Ocean dynamics:  vertical component(s) of the momentum mixing trend 
    5    !!============================================================================== 
     5   !!====================================================================== 
    66   !! History :  OPA  !  1990-10  (B. Blanke)  Original code 
    77   !!            8.0  !  1997-05  (G. Madec)  vertical component of isopycnal 
    8    !!   NEMO     1.0  !  2002-08  (G. Madec)  F90: Free form and module 
     8   !!   NEMO     0.5  !  2002-08  (G. Madec)  F90: Free form and module 
    99   !!            3.3  !  2010-04  (M. Leclair, G. Madec)  Forcing averaged over 2 time steps 
    1010   !!---------------------------------------------------------------------- 
    1111 
    1212   !!---------------------------------------------------------------------- 
    13    !!   dyn_zdf_imp  : update the momentum trend with the vertical diffu- 
    14    !!                  sion using a implicit time-stepping. 
     13   !!   dyn_zdf_imp  : update the momentum trend with the vertical diffusion using a implicit time-stepping 
    1514   !!---------------------------------------------------------------------- 
    1615   USE oce             ! ocean dynamics and tracers 
    … …  
    5554      !! ** Action : - Update (ua,va) arrays with the after vertical diffusive mixing trend. 
    5655      !!--------------------------------------------------------------------- 
    57       USE oce, ONLY :  zwd   => ta      ! use ta as workspace 
    58       USE oce, ONLY :  zws   => sa      ! use sa as workspace 
    59       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    60       USE wrk_nemo, ONLY: zwi => wrk_3d_3 ! workspace 
    61       !! 
    62       INTEGER , INTENT( in ) ::   kt    ! ocean time-step index 
    63       REAL(wp), INTENT( in ) ::  p2dt   ! vertical profile of tracer time-step 
    64       !! 
    65       INTEGER  ::   ji, jj, jk             ! dummy loop indices 
    66       REAL(wp) ::   z1_p2dt, zcoef         ! temporary scalars 
    67       REAL(wp) ::   zzwi, zzws, zrhs       ! temporary scalars 
     56      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     57      USE oce     , ONLY:  zwd  => ta       , zws   => sa   ! (ta,sa) used as 3D workspace 
     58      USE wrk_nemo, ONLY:   zwi => wrk_3d_3                 ! 3D workspace 
     59      !! 
     60      INTEGER , INTENT(in) ::   kt    ! ocean time-step index 
     61      REAL(wp), INTENT(in) ::  p2dt   ! vertical profile of tracer time-step 
     62      !! 
     63      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     64      REAL(wp) ::   z1_p2dt, zcoef, zzwi, zzws, zrhs   ! local scalars 
    6865      !!---------------------------------------------------------------------- 
    6966 
    70       IF(wrk_in_use(3, 3))THEN 
    71          CALL ctl_stop('dyn_zdf_imp : requested workspace array unavailable.') 
    72          RETURN 
     67      IF( wrk_in_use(3, 3) ) THEN 
     68         CALL ctl_stop('dyn_zdf_imp: requested workspace array unavailable')   ;   RETURN 
    7369      END IF 
    7470 
    … …  
    260256      END DO 
    261257      ! 
    262       IF(wrk_not_released(3, 3))THEN 
    263          CALL ctl_stop('dyn_zdf_imp : failed to release workspace array.') 
    264       END IF 
     258      IF( wrk_not_released(3, 3) )   CALL ctl_stop('dyn_zdf_imp: failed to release workspace array') 
    265259      ! 
    266260   END SUBROUTINE dyn_zdf_imp 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90

    r2636 r2690  
    2929   USE obc_oce 
    3030   USE bdy_oce 
    31    USE diaar5, ONLY :   lk_diaar5 
     31   USE diaar5, ONLY:   lk_diaar5 
    3232   USE iom 
    33    USE sbcrnf, ONLY  : h_rnf, nk_rnf  ! River runoff  
     33   USE sbcrnf, ONLY: h_rnf, nk_rnf   ! River runoff  
    3434#if defined key_agrif 
    3535   USE agrif_opa_update 
    … …  
    5252   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    5353   !! $Id$ 
    54    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    55    !!---------------------------------------------------------------------- 
    56  
     54   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     55   !!---------------------------------------------------------------------- 
    5756CONTAINS 
    5857 
    … …  
    7675      !! Reference  : Leclair, M., and G. Madec, 2009, Ocean Modelling. 
    7776      !!---------------------------------------------------------------------- 
    78       USE oce, ONLY :   z3d => ta   ! use ta as 3D workspace 
    79       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    80       USE wrk_nemo, ONLY: zhdiv => wrk_2d_1, z2d => wrk_2d_2 
    81       !! 
     77      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     78      USE oce     , ONLY:   z3d   => ta                           ! ta used as 3D workspace 
     79      USE wrk_nemo, ONLY:   zhdiv => wrk_2d_1 , z2d => wrk_2d_2   ! 2D workspace 
     80      ! 
    8281      INTEGER, INTENT(in) ::   kt   ! time step 
    83       !! 
    84       INTEGER  ::   ji, jj, jk      ! dummy loop indices 
    85       REAL(wp) ::   zcoefu, zcoefv, zcoeff      ! temporary scalars 
    86       REAL(wp) ::   z2dt, z1_2dt, z1_rau0       ! temporary scalars 
     82      ! 
     83      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     84      REAL(wp) ::   zcoefu, zcoefv, zcoeff, z2dt, z1_2dt, z1_rau0   ! local scalars 
    8785      !!---------------------------------------------------------------------- 
    8886 
    … …  
    9795         IF(lwp) WRITE(numout,*) '~~~~~~~ ' 
    9896         ! 
    99          wn(:,:,jpk) = 0.e0                   ! bottom boundary condition: w=0 (set once for all) 
     97         wn(:,:,jpk) = 0._wp                  ! bottom boundary condition: w=0 (set once for all) 
    10098         ! 
    10199         IF( lk_vvl ) THEN                    ! before and now Sea SSH at u-, v-, f-points (vvl case only) 
    … …  
    150148         hv(:,:) = hv_0(:,:) + sshv_n(:,:) 
    151149         !                                            ! now masked inverse of the ocean depth (at u- and v-points) 
    152          hur(:,:) = umask(:,:,1) / ( hu(:,:) + 1.e0 - umask(:,:,1) ) 
    153          hvr(:,:) = vmask(:,:,1) / ( hv(:,:) + 1.e0 - vmask(:,:,1) ) 
     150         hur(:,:) = umask(:,:,1) / ( hu(:,:) + 1._wp - umask(:,:,1) ) 
     151         hvr(:,:) = vmask(:,:,1) / ( hv(:,:) + 1._wp - vmask(:,:,1) ) 
    154152         !  
    155153      ENDIF 
    … …  
    157155      CALL div_cur( kt )                              ! Horizontal divergence & Relative vorticity 
    158156      ! 
    159       z2dt = 2. * rdt                                 ! set time step size (Euler/Leapfrog) 
    160       IF( neuler == 0 .AND. kt == nit000 )   z2dt =rdt 
     157      z2dt = 2._wp * rdt                              ! set time step size (Euler/Leapfrog) 
     158      IF( neuler == 0 .AND. kt == nit000 )   z2dt = rdt 
    161159 
    162160      !                                           !------------------------------! 
    163161      !                                           !   After Sea Surface Height   ! 
    164162      !                                           !------------------------------! 
    165       zhdiv(:,:) = 0.e0 
     163      zhdiv(:,:) = 0._wp 
    166164      DO jk = 1, jpkm1                                 ! Horizontal divergence of barotropic transports 
    167165        zhdiv(:,:) = zhdiv(:,:) + fse3t(:,:,jk) * hdivn(:,:,jk) 
    … …  
    171169      ! because emp_b field is initialized with the vlaues of emp field. Hence, 0.5 * ( emp + emp_b ) = emp 
    172170      z1_rau0 = 0.5 / rau0 
    173       ssha(:,:) = (  sshb(:,:) - z2dt * ( z1_rau0 * ( emp_b(:,:) + emp(:,:) ) + zhdiv(:,:) )  ) & 
    174       &                      * tmask(:,:,1) 
     171      ssha(:,:) = (  sshb(:,:) - z2dt * ( z1_rau0 * ( emp_b(:,:) + emp(:,:) ) + zhdiv(:,:) )  ) * tmask(:,:,1) 
    175172 
    176173#if defined key_agrif 
    177       CALL agrif_ssh(kt) 
     174      CALL agrif_ssh( kt ) 
    178175#endif 
    179176#if defined key_obc 
    180177      IF( Agrif_Root() ) THEN  
    181178         ssha(:,:) = ssha(:,:) * obctmsk(:,:) 
    182          CALL lbc_lnk( ssha, 'T', 1. )                ! absolutly compulsory !! (jmm) 
     179         CALL lbc_lnk( ssha, 'T', 1. )                 ! absolutly compulsory !! (jmm) 
    183180      ENDIF 
    184181#endif 
    … …  
    200197            END DO 
    201198         END DO 
    202          ! Boundaries conditions 
    203          CALL lbc_lnk( sshu_a, 'U', 1. ) 
    204          CALL lbc_lnk( sshv_a, 'V', 1. ) 
    205       ENDIF 
    206 ! Include the IAU weighted SSH increment 
     199         CALL lbc_lnk( sshu_a, 'U', 1. )   ;   CALL lbc_lnk( sshv_a, 'V', 1. )      ! Boundaries conditions 
     200      ENDIF 
     201       
    207202#if defined key_asminc 
    208       IF( ( lk_asminc ).AND.( ln_sshinc ).AND.( ln_asmiau ) ) THEN 
     203      !                                                ! Include the IAU weighted SSH increment 
     204      IF( lk_asminc .AND. ln_sshinc .AND. ln_asmiau ) THEN 
    209205         CALL ssh_asm_inc( kt ) 
    210206         ssha(:,:) = ssha(:,:) + z2dt * ssh_iau(:,:) 
    … …  
    218214      DO jk = jpkm1, 1, -1                             ! integrate from the bottom the hor. divergence 
    219215         ! - ML - need 3 lines here because replacement of fse3t by its expression yields too long lines otherwise 
    220          wn(:,:,jk) = wn(:,:,jk+1) -    fse3t_n(:,:,jk) * hdivn(:,:,jk)        & 
    221             &                      - (  fse3t_a(:,:,jk) - fse3t_b(:,:,jk) )    & 
     216         wn(:,:,jk) = wn(:,:,jk+1) -   fse3t_n(:,:,jk) * hdivn(:,:,jk)        & 
     217            &                      - ( fse3t_a(:,:,jk) - fse3t_b(:,:,jk) )    & 
    222218            &                         * tmask(:,:,jk) * z1_2dt 
    223219#if defined key_bdy 
    … …  
    281277 
    282278      !                       !--------------------------! 
    283       IF( lk_vvl ) THEN       !  Variable volume levels  ! 
     279      IF( lk_vvl ) THEN       !  Variable volume levels  !     (ssh at t-, u-, v, f-points) 
    284280         !                    !--------------------------! 
    285281         ! 
    286          ! ssh at t-, u-, v, f-points 
    287          !=========================== 
    288          IF( neuler == 0 .AND. kt == nit000 ) THEN      ! Euler time-stepping at first time-step : no filter 
    289             sshn  (:,:) = ssha  (:,:)                        ! now <-- after  (before already = now) 
     282         IF( neuler == 0 .AND. kt == nit000 ) THEN    !** Euler time-stepping at first time-step : no filter 
     283            sshn  (:,:) = ssha  (:,:)                       ! now <-- after  (before already = now) 
    290284            sshu_n(:,:) = sshu_a(:,:) 
    291285            sshv_n(:,:) = sshv_a(:,:) 
    292             DO jj = 1, jpjm1 
    293                DO ji = 1, jpim1      ! NO Vector Opt. 
    294                   sshf_n(ji,jj) = 0.5  * umask(ji,jj,1) * umask(ji,jj+1,1)                   & 
    295                      &               / ( e1f(ji,jj  ) * e2f(ji,jj  ) )                     & 
    296                      &               * ( e1u(ji,jj  ) * e2u(ji,jj  ) * sshu_n(ji,jj  )     & 
    297                      &                 + e1u(ji,jj+1) * e2u(ji,jj+1) * sshu_n(ji,jj+1) ) 
    298                END DO 
    299             END DO 
    300             ! Boundaries conditions 
    301             CALL lbc_lnk( sshf_n, 'F', 1. ) 
    302          ELSE                                           ! Leap-Frog time-stepping: Asselin filter + swap 
    303             zec = atfp * rdt / rau0 
    304             DO jj = 1, jpj 
    305                DO ji = 1, jpi                                ! before <-- now filtered 
    306                   sshb  (ji,jj) = sshn  (ji,jj) + atfp * ( sshb(ji,jj) - 2 * sshn(ji,jj) + ssha(ji,jj) )   & 
    307                      &                          - zec  * ( emp_b(ji,jj) - emp(ji,jj) ) * tmask(ji,jj,1) 
    308                   sshn  (ji,jj) = ssha  (ji,jj)              ! now <-- after 
    309                   sshu_n(ji,jj) = sshu_a(ji,jj) 
    310                   sshv_n(ji,jj) = sshv_a(ji,jj) 
    311                END DO 
    312             END DO 
    313             DO jj = 1, jpjm1 
     286            DO jj = 1, jpjm1                                ! ssh now at f-point 
    314287               DO ji = 1, jpim1      ! NO Vector Opt. 
    315288                  sshf_n(ji,jj) = 0.5  * umask(ji,jj,1) * umask(ji,jj+1,1)                 & 
    … …  
    319292               END DO 
    320293            END DO 
    321             ! Boundaries conditions 
    322             CALL lbc_lnk( sshf_n, 'F', 1. ) 
    323             DO jj = 1, jpjm1 
     294            CALL lbc_lnk( sshf_n, 'F', 1. )                 ! Boundaries conditions 
     295            ! 
     296         ELSE                                         !** Leap-Frog time-stepping: Asselin filter + swap 
     297            zec = atfp * rdt / rau0 
     298            DO jj = 1, jpj 
     299               DO ji = 1, jpi                               ! before <-- now filtered 
     300                  sshb  (ji,jj) = sshn  (ji,jj) + atfp * ( sshb(ji,jj) - 2 * sshn(ji,jj) + ssha(ji,jj) )   & 
     301                     &                          - zec  * ( emp_b(ji,jj) - emp(ji,jj) ) * tmask(ji,jj,1) 
     302                  sshn  (ji,jj) = ssha  (ji,jj)             ! now <-- after 
     303                  sshu_n(ji,jj) = sshu_a(ji,jj) 
     304                  sshv_n(ji,jj) = sshv_a(ji,jj) 
     305               END DO 
     306            END DO 
     307            DO jj = 1, jpjm1                                ! ssh now at f-point 
     308               DO ji = 1, jpim1      ! NO Vector Opt. 
     309                  sshf_n(ji,jj) = 0.5  * umask(ji,jj,1) * umask(ji,jj+1,1)                 & 
     310                     &               / ( e1f(ji,jj  ) * e2f(ji,jj  ) )                     & 
     311                     &               * ( e1u(ji,jj  ) * e2u(ji,jj  ) * sshu_n(ji,jj  )     & 
     312                     &                 + e1u(ji,jj+1) * e2u(ji,jj+1) * sshu_n(ji,jj+1) ) 
     313               END DO 
     314            END DO 
     315            CALL lbc_lnk( sshf_n, 'F', 1. )                 ! Boundaries conditions 
     316            ! 
     317            DO jj = 1, jpjm1                                ! ssh before at u- & v-points 
    324318               DO ji = 1, jpim1      ! NO Vector Opt. 
    325319                  sshu_b(ji,jj) = 0.5  * umask(ji,jj,1) / ( e1u(ji  ,jj) * e2u(ji  ,jj) )                   & 
    … …  
    331325               END DO 
    332326            END DO 
    333             ! Boundaries conditions 
    334327            CALL lbc_lnk( sshu_b, 'U', 1. ) 
    335             CALL lbc_lnk( sshv_b, 'V', 1. ) 
     328            CALL lbc_lnk( sshv_b, 'V', 1. )            !  Boundaries conditions 
     329            ! 
    336330         ENDIF 
    337331         !                    !--------------------------! 
    338       ELSE                    !        fixed levels      ! 
     332      ELSE                    !        fixed levels      !     (ssh at t-point only) 
    339333         !                    !--------------------------! 
    340334         ! 
    341          ! ssh at t-point only 
    342          !==================== 
    343          IF( neuler == 0 .AND. kt == nit000 ) THEN      ! Euler time-stepping at first time-step : no filter 
    344             sshn(:,:) = ssha(:,:)                            ! now <-- after  (before already = now) 
    345             ! 
    346          ELSE                                           ! Leap-Frog time-stepping: Asselin filter + swap 
     335         IF( neuler == 0 .AND. kt == nit000 ) THEN    !** Euler time-stepping at first time-step : no filter 
     336            sshn(:,:) = ssha(:,:)                           ! now <-- after  (before already = now) 
     337            ! 
     338         ELSE                                               ! Leap-Frog time-stepping: Asselin filter + swap 
    347339            DO jj = 1, jpj 
    348                DO ji = 1, jpi                                ! before <-- now filtered 
     340               DO ji = 1, jpi                               ! before <-- now filtered 
    349341                  sshb(ji,jj) = sshn(ji,jj) + atfp * ( sshb(ji,jj) - 2 * sshn(ji,jj) + ssha(ji,jj) ) 
    350                   sshn(ji,jj) = ssha(ji,jj)                  ! now <-- after 
     342                  sshn(ji,jj) = ssha(ji,jj)                 ! now <-- after 
    351343               END DO 
    352344            END DO 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/FLO/flo_oce.F90

    r2618 r2690  
    5656      !!                 ***  FUNCTION flo_oce_alloc  *** 
    5757      !!---------------------------------------------------------------------- 
    58       ALLOCATE( wb(jpi,jpj,jpk), Stat=flo_oce_alloc ) 
     58      ALLOCATE( wb(jpi,jpj,jpk)   , STAT=flo_oce_alloc ) 
    5959      ! 
    6060      IF( lk_mpp             )   CALL mpp_sum ( flo_oce_alloc ) 
    61       IF( flo_oce_alloc /= 0 )   CALL ctl_warn('flo_oce_alloc: failed to allocate arrays.') 
     61      IF( flo_oce_alloc /= 0 )   CALL ctl_warn('flo_oce_alloc: failed to allocate arrays') 
    6262   END FUNCTION flo_oce_alloc 
    6363 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/IOM/prtctl.F90

    r2633 r2690  
    11MODULE prtctl 
    2    !!============================================================================== 
     2   !!====================================================================== 
    33   !!                       ***  MODULE prtctl   *** 
    4    !! Ocean system   : print all SUM trends for each processor domain 
    5    !!============================================================================== 
     4   !! Ocean system : print all SUM trends for each processor domain 
     5   !!====================================================================== 
     6   !! History :  9.0  !  05-07  (C. Talandier) original code 
     7   !!---------------------------------------------------------------------- 
    68   USE dom_oce          ! ocean space and time domain variables 
    79   USE in_out_manager   ! I/O manager 
    … …  
    1113   PRIVATE 
    1214 
    13    !! * Module declaration 
    14    INTEGER, DIMENSION(:), ALLOCATABLE :: numid 
    15    INTEGER, DIMENSION(:), ALLOCATABLE, SAVE ::   &  !: 
    16       nlditl , nldjtl ,   &  !: first, last indoor index for each i-domain 
    17       nleitl , nlejtl ,   &  !: first, last indoor index for each j-domain 
    18       nimpptl, njmpptl,   &  !: i-, j-indexes for each processor 
    19       nlcitl , nlcjtl ,   &  !: dimensions of every subdomain 
    20       ibonitl, ibonjtl 
    21  
    22    REAL(wp), DIMENSION(:), ALLOCATABLE ::   &  !: 
    23       t_ctll , s_ctll ,   &  !: previous trend values 
    24       u_ctll , v_ctll 
    25  
    26    INTEGER ::   ktime        !: time step 
    27  
    28    !! * Routine accessibility 
     15   INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   numid 
     16   INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   nlditl , nldjtl    ! first, last indoor index for each i-domain 
     17   INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   nleitl , nlejtl    ! first, last indoor index for each j-domain 
     18   INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   nimpptl, njmpptl   ! i-, j-indexes for each processor 
     19   INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   nlcitl , nlcjtl    ! dimensions of every subdomain 
     20   INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   ibonitl, ibonjtl   ! 
     21 
     22   REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE ::   t_ctll , s_ctll    ! previous tracer trend values 
     23   REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE ::   u_ctll , v_ctll    ! previous velocity trend values 
     24 
     25   INTEGER ::   ktime   ! time step 
     26 
    2927   PUBLIC prt_ctl         ! called by all subroutines 
    3028   PUBLIC prt_ctl_info    ! called by all subroutines 
    3129   PUBLIC prt_ctl_init    ! called by opa.F90 
     30 
    3231   !!---------------------------------------------------------------------- 
    3332   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    3433   !! $Id$  
    35    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     34   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3635   !!---------------------------------------------------------------------- 
    37  
    38  
    3936CONTAINS 
    4037 
    41    SUBROUTINE prt_ctl (tab2d_1, tab3d_1, mask1, clinfo1, tab2d_2, tab3d_2, mask2, clinfo2, ovlap, kdim, clinfo3) 
     38   SUBROUTINE prt_ctl (tab2d_1, tab3d_1, mask1, clinfo1, tab2d_2, tab3d_2,   & 
     39      &                                  mask2, clinfo2, ovlap, kdim, clinfo3 ) 
    4240      !!---------------------------------------------------------------------- 
    4341      !!                     ***  ROUTINE prt_ctl  *** 
    … …  
    7472      !!                    kdim    : k- direction for 3D arrays  
    7573      !!                    clinfo3 : additional information  
    76       !! 
    77       !! History : 
    78       !!   9.0  !  05-07  (C. Talandier) original code 
    79       !!---------------------------------------------------------------------- 
    80       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    81       USE wrk_nemo, ONLY: ztab2d_1 => wrk_2d_1, ztab2d_2 => wrk_2d_2 
    82       USE wrk_nemo, ONLY:   zmask1 => wrk_3d_1,   zmask2 => wrk_3d_2, & 
    83                           ztab3d_1 => wrk_3d_3, ztab3d_2 => wrk_3d_4 
    84       !! * Arguments 
    85       REAL(wp), DIMENSION(:,:)  , INTENT(in), OPTIONAL :: tab2d_1 
    86       REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL :: tab3d_1 
    87       REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL :: mask1 
    88       CHARACTER (len=*)         , INTENT(in), OPTIONAL :: clinfo1 
    89       REAL(wp), DIMENSION(:,:)  , INTENT(in), OPTIONAL :: tab2d_2 
    90       REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL :: tab3d_2 
    91       REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL :: mask2 
    92       CHARACTER (len=*)         , INTENT(in), OPTIONAL :: clinfo2 
    93       INTEGER                   , INTENT(in), OPTIONAL :: ovlap 
    94       INTEGER                   , INTENT(in), OPTIONAL :: kdim 
    95       CHARACTER (len=*)         , INTENT(in), OPTIONAL :: clinfo3 
    96  
    97       !! * Local declarations 
    98       INTEGER :: overlap, jn, sind, eind, kdir,j_id 
     74      !!---------------------------------------------------------------------- 
     75      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     76      USE wrk_nemo, ONLY:   ztab2d_1 => wrk_2d_1 , ztab2d_2 => wrk_2d_2 
     77      USE wrk_nemo, ONLY:   zmask1   => wrk_3d_1 , zmask2   => wrk_3d_2  
     78      USE wrk_nemo, ONLY:   ztab3d_1 => wrk_3d_3 , ztab3d_2 => wrk_3d_4 
     79      ! 
     80      REAL(wp), DIMENSION(:,:)  , INTENT(in), OPTIONAL ::   tab2d_1 
     81      REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL ::   tab3d_1 
     82      REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL ::   mask1 
     83      CHARACTER (len=*)         , INTENT(in), OPTIONAL ::   clinfo1 
     84      REAL(wp), DIMENSION(:,:)  , INTENT(in), OPTIONAL ::   tab2d_2 
     85      REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL ::   tab3d_2 
     86      REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL ::   mask2 
     87      CHARACTER (len=*)         , INTENT(in), OPTIONAL ::   clinfo2 
     88      INTEGER                   , INTENT(in), OPTIONAL ::   ovlap 
     89      INTEGER                   , INTENT(in), OPTIONAL ::   kdim 
     90      CHARACTER (len=*)         , INTENT(in), OPTIONAL ::   clinfo3 
     91      ! 
    9992      CHARACTER (len=15) :: cl2 
     93      INTEGER ::   overlap, jn, sind, eind, kdir,j_id 
    10094      REAL(wp) :: zsum1, zsum2, zvctl1, zvctl2 
    10195      !!---------------------------------------------------------------------- 
    10296 
    103       IF( wrk_in_use(2, 1,2) .OR. wrk_in_use(3, 1,2,3,4) )THEN 
    104          CALL ctl_stop('prt_ctl : requested workspace arrays unavailable.') 
    105          RETURN 
    106       END IF 
     97      IF( wrk_in_use(2, 1,2) .OR. wrk_in_use(3, 1,2,3,4) ) THEN 
     98         CALL ctl_stop('prt_ctl : requested workspace arrays unavailable')   ;   RETURN 
     99      ENDIF 
    107100 
    108101      ! Arrays, scalars initialization  
    … …  
    122115 
    123116      ! Control of optional arguments 
    124       IF( PRESENT(clinfo2) )  cl2            = clinfo2 
    125       IF( PRESENT(ovlap)   )  overlap        = ovlap 
    126       IF( PRESENT(kdim)    )  kdir           = kdim 
    127       IF( PRESENT(tab2d_1) )  ztab2d_1(:,:)  = tab2d_1(:,:) 
    128       IF( PRESENT(tab2d_2) )  ztab2d_2(:,:)  = tab2d_2(:,:) 
    129       IF( PRESENT(tab3d_1) )  ztab3d_1(:,:,1:kdir)= tab3d_1(:,:,:) 
    130       IF( PRESENT(tab3d_2) )  ztab3d_2(:,:,1:kdir)= tab3d_2(:,:,:) 
    131       IF( PRESENT(mask1)   )  zmask1  (:,:,:)= mask1  (:,:,:) 
    132       IF( PRESENT(mask2)   )  zmask2  (:,:,:)= mask2  (:,:,:) 
    133  
    134       IF( lk_mpp )   THEN 
    135          ! processor number 
     117      IF( PRESENT(clinfo2) )   cl2                  = clinfo2 
     118      IF( PRESENT(ovlap)   )   overlap              = ovlap 
     119      IF( PRESENT(kdim)    )   kdir                 = kdim 
     120      IF( PRESENT(tab2d_1) )   ztab2d_1(:,:)        = tab2d_1(:,:) 
     121      IF( PRESENT(tab2d_2) )   ztab2d_2(:,:)        = tab2d_2(:,:) 
     122      IF( PRESENT(tab3d_1) )   ztab3d_1(:,:,1:kdir) = tab3d_1(:,:,:) 
     123      IF( PRESENT(tab3d_2) )   ztab3d_2(:,:,1:kdir) = tab3d_2(:,:,:) 
     124      IF( PRESENT(mask1)   )   zmask1  (:,:,:)      = mask1  (:,:,:) 
     125      IF( PRESENT(mask2)   )   zmask2  (:,:,:)      = mask2  (:,:,:) 
     126 
     127      IF( lk_mpp ) THEN       ! processor number 
    136128         sind = narea 
    137129         eind = narea 
    138       ELSE 
    139          ! processors total number 
     130      ELSE                    ! processors total number 
    140131         sind = 1 
    141132         eind = ijsplt 
    … …  
    213204      ENDDO 
    214205 
    215       IF( wrk_not_released(2, 1,2) .OR. wrk_not_released(3, 1,2,3,4) )THEN 
    216          CALL ctl_stop('prt_ctl : failed to release workspace arrays.') 
    217       END IF 
    218  
     206      IF( wrk_not_released(2, 1,2)     .OR.   & 
     207          wrk_not_released(3, 1,2,3,4) )   CALL ctl_stop('prt_ctl: failed to release workspace arrays') 
     208      ! 
    219209   END SUBROUTINE prt_ctl 
    220210 
    … …  
    231221      !!                    clinfo2 : information about the ivar2 
    232222      !!                    ivar2   : value to print 
    233       !! 
    234       !! History : 
    235       !!   9.0  !  05-07  (C. Talandier) original code 
    236       !!---------------------------------------------------------------------- 
    237       !! * Arguments 
    238       CHARACTER (len=*), INTENT(in) ::   clinfo1 
     223      !!---------------------------------------------------------------------- 
     224      CHARACTER (len=*), INTENT(in)           ::   clinfo1 
    239225      INTEGER          , INTENT(in), OPTIONAL ::   ivar1 
    240226      CHARACTER (len=*), INTENT(in), OPTIONAL ::   clinfo2 
    241227      INTEGER          , INTENT(in), OPTIONAL ::   ivar2 
    242228      INTEGER          , INTENT(in), OPTIONAL ::   itime 
    243  
    244       !! * Local declarations 
     229      ! 
    245230      INTEGER :: jn, sind, eind, iltime, j_id 
    246231      !!---------------------------------------------------------------------- 
    247232 
    248       IF( lk_mpp )   THEN 
    249          ! processor number 
     233      IF( lk_mpp ) THEN       ! processor number 
    250234         sind = narea 
    251235         eind = narea 
    252       ELSE 
    253          ! total number of processors 
     236      ELSE                    ! total number of processors 
    254237         sind = 1 
    255238         eind = ijsplt 
    … …  
    268251      ! Loop over each sub-domain, i.e. number of processors ijsplt 
    269252      DO jn = sind, eind 
    270           
    271          ! Set logical unit 
    272          j_id = numid(jn - narea + 1) 
    273  
     253         ! 
     254         j_id = numid(jn - narea + 1)         ! Set logical unit 
     255         ! 
    274256         IF( PRESENT(ivar1) .AND. PRESENT(clinfo2) .AND. PRESENT(ivar2) )   THEN 
    275257            WRITE(j_id,*)clinfo1, ivar1, clinfo2, ivar2 
    … …  
    283265            WRITE(j_id,*)clinfo1 
    284266         ENDIF 
    285  
    286       ENDDO 
    287  
    288  
    289       END SUBROUTINE prt_ctl_info 
     267         ! 
     268      END DO 
     269      ! 
     270   END SUBROUTINE prt_ctl_info 
     271 
    290272 
    291273   SUBROUTINE prt_ctl_init 
    … …  
    294276      !! 
    295277      !! ** Purpose :   open ASCII files & compute indices 
    296       !! 
    297       !! History : 
    298       !!   9.0  !  05-07  (C. Talandier) original code 
    299       !!---------------------------------------------------------------------- 
    300       !! * Local declarations 
     278      !!---------------------------------------------------------------------- 
    301279      INTEGER ::   jn, sind, eind, j_id 
    302280      CHARACTER (len=28) :: clfile_out 
    … …  
    306284 
    307285      ! Allocate arrays 
    308       ALLOCATE(nlditl (ijsplt)) 
    309       ALLOCATE(nldjtl (ijsplt)) 
    310       ALLOCATE(nleitl (ijsplt)) 
    311       ALLOCATE(nlejtl (ijsplt)) 
    312       ALLOCATE(nimpptl(ijsplt)) 
    313       ALLOCATE(njmpptl(ijsplt)) 
    314       ALLOCATE(nlcitl (ijsplt)) 
    315       ALLOCATE(nlcjtl (ijsplt)) 
    316       ALLOCATE(t_ctll (ijsplt)) 
    317       ALLOCATE(s_ctll (ijsplt)) 
    318       ALLOCATE(u_ctll (ijsplt)) 
    319       ALLOCATE(v_ctll (ijsplt)) 
    320       ALLOCATE(ibonitl(ijsplt)) 
    321       ALLOCATE(ibonjtl(ijsplt)) 
     286      ALLOCATE( nlditl(ijsplt) , nleitl(ijsplt) , nimpptl(ijsplt) , ibonitl(ijsplt) ,   & 
     287         &      nldjtl(ijsplt) , nlejtl(ijsplt) , njmpptl(ijsplt) , ibonjtl(ijsplt) ,   & 
     288         &      nlcitl(ijsplt) , t_ctll(ijsplt) , u_ctll (ijsplt) ,                     & 
     289         &      nlcjtl(ijsplt) , s_ctll(ijsplt) , v_ctll (ijsplt)                       ) 
    322290 
    323291      ! Initialization  
    324       t_ctll(:)=0.e0 
    325       s_ctll(:)=0.e0 
    326       u_ctll(:)=0.e0 
    327       v_ctll(:)=0.e0 
     292      t_ctll(:) = 0.e0 
     293      s_ctll(:) = 0.e0 
     294      u_ctll(:) = 0.e0 
     295      v_ctll(:) = 0.e0 
    328296      ktime = 1 
    329297 
    … …  
    356324      ENDIF 
    357325 
    358       ALLOCATE(numid(eind-sind+1)) 
     326      ALLOCATE( numid(eind-sind+1) ) 
    359327 
    360328      DO jn = sind, eind 
    … …  
    4033719003     FORMAT(a20,i4.4,a17,i4.4) 
    4043729004     FORMAT(a11,i4.4,a26,i4.4,a14) 
    405       ENDDO 
    406  
     373      END DO 
     374      ! 
    407375   END SUBROUTINE prt_ctl_init 
    408376 
    … …  
    445413      !!   8.5  !  02-08  (G. Madec)  F90 : free form 
    446414      !!---------------------------------------------------------------------- 
    447       !! * Local variables 
    448415      INTEGER ::   ji, jj, jn               ! dummy loop indices 
    449416      INTEGER ::   & 
    … …  
    454421         nrecil, nrecjl, nldil, nleil, nldjl, nlejl 
    455422 
    456       INTEGER, DIMENSION(:,:), ALLOCATABLE ::   & 
    457          iimpptl, ijmpptl, ilcitl, ilcjtl       ! temporary workspace 
     423      INTEGER, DIMENSION(:,:), ALLOCATABLE ::   iimpptl, ijmpptl, ilcitl, ilcjtl   ! workspace 
    458424      REAL(wp) ::   zidom, zjdom            ! temporary scalars 
    459425      !!---------------------------------------------------------------------- 
    … …  
    575541         nlejtl(jn) = nlejl 
    576542      END DO 
    577  
    578       DEALLOCATE(iimpptl) 
    579       DEALLOCATE(ijmpptl) 
    580       DEALLOCATE(ilcitl) 
    581       DEALLOCATE(ilcjtl) 
    582  
     543      ! 
     544      DEALLOCATE( iimpptl, ijmpptl, ilcitl, ilcjtl ) 
     545      ! 
    583546   END SUBROUTINE sub_dom 
    584547 
     548   !!====================================================================== 
    585549END MODULE prtctl 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90

    r2668 r2690  
    17591759      !!---------------------------------------------------------------------- 
    17601760 
    1761       IF(wrk_in_use(2, 1) ) THEN 
     1761      IF( wrk_in_use(2, 1) ) THEN 
    17621762         WRITE(kumout, cform_err) 
    17631763         WRITE(kumout,*) 'mppobc : requested workspace array unavailable' 
    17641764         CALL mppstop 
    1765       END IF 
     1765      ENDIF 
    17661766 
    17671767      ! boundary condition initialization 
    … …  
    19141914      END DO 
    19151915      ! 
    1916       IF(wrk_not_released(2, 1) ) THEN 
     1916      IF( wrk_not_released(2, 1) ) THEN 
    19171917         WRITE(kumout, cform_err) 
    19181918         WRITE(kumout,*) 'mppobc : failed to release workspace array' 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90

    r2442 r2690  
    2020   PRIVATE 
    2121 
    22    !! * Routine accessibility 
    2322   PUBLIC mpp_init       ! called by opa.F90 
    2423   PUBLIC mpp_init2      ! called by opa.F90 
    … …  
    2928   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    3029   !! $Id$  
    31    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    32    !!---------------------------------------------------------------------- 
    33  
     30   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     31   !!---------------------------------------------------------------------- 
    3432CONTAINS 
    3533 
    … …  
    128126      !!   8.5  !  02-08  (G. Madec)  F90 : free form 
    129127      !!---------------------------------------------------------------------- 
    130       !! * Local variables 
    131       INTEGER ::   ji, jj, jn               ! dummy loop indices 
    132       INTEGER ::   & 
    133          ii, ij, ifreq, il1, il2,        &  ! temporary integers 
    134          iresti, irestj, ijm1, imil,     &  !    "          " 
    135          inum                               ! temporary logical unit 
    136  
    137       INTEGER, DIMENSION(jpni,jpnj) ::   & 
    138          iimppt, ijmppt, ilcit, ilcjt       ! temporary workspace 
    139       REAL(wp) ::   zidom, zjdom            ! temporary scalars 
     128      INTEGER  ::   ji, jj, jn   ! dummy loop indices 
     129      INTEGER  ::   ii, ij, ifreq, il1, il2            ! local integers 
     130      INTEGER  ::   iresti, irestj, ijm1, imil, inum   !   -      - 
     131      REAL(wp) ::   zidom, zjdom                       ! local scalars 
     132      INTEGER, DIMENSION(jpni,jpnj) ::   iimppt, ijmppt, ilcit, ilcjt   ! local workspace 
    140133      !!---------------------------------------------------------------------- 
    141134 
    … …  
    451444      !!   " "  !  08-12  (A. Coward)  addition in case of jpni*jpnj < jpnij 
    452445      !!---------------------------------------------------------------------- 
    453       !! Local declarations 
    454  
    455       INTEGER, DIMENSION(2) ::   & 
    456          iglo, iloc, iabsf, iabsl, ihals, ihale, idid 
     446      INTEGER, DIMENSION(2) ::   iglo, iloc, iabsf, iabsl, ihals, ihale, idid 
    457447      !!---------------------------------------------------------------------- 
    458448 
    … …  
    482472          WRITE(numout,*) '                    ihale = ', ihale(1), ihale(2) 
    483473      ENDIF 
    484  
     474      ! 
    485475      CALL flio_dom_set ( jpnij, nproc, idid, iglo, iloc, iabsf, iabsl, ihals, ihale, 'BOX', nidom) 
    486  
     476      ! 
    487477   END SUBROUTINE mpp_init_ioipsl   
    488478 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn.F90

    r2590 r2690  
    3838   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    3939   !! $Id$  
    40    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    41    !!---------------------------------------------------------------------- 
    42  
     40   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     41   !!---------------------------------------------------------------------- 
    4342CONTAINS 
    4443 
    … …  
    6362      !!---------------------------------------------------------------------- 
    6463      INTEGER ::   ioptio         ! ??? 
    65       LOGICAL :: ll_print = .FALSE.    ! Logical flag for printing viscosity coef. 
     64      LOGICAL ::   ll_print = .FALSE.    ! Logical flag for printing viscosity coef. 
    6665      !!  
    6766      NAMELIST/namdyn_ldf/ ln_dynldf_lap  , ln_dynldf_bilap,                  & 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c1d.h90

    r2528 r2690  
    2424      !! 
    2525      !!---------------------------------------------------------------------- 
    26       !! * Arguments 
    27       LOGICAL, INTENT (in) :: ld_print   ! If true, output arrays on numout 
    28  
    29       !! * Local variables 
     26      LOGICAL, INTENT(in) :: ld_print   ! If true, output arrays on numout 
     27      ! 
    3028      INTEGER  ::   jk   ! dummy loop indice 
    3129      REAL(wp) ::   zdam,  zwam,  zm00,  zm01,  zmhf,  zmhs 
    … …  
    3735      IF(lwp) WRITE(numout,*) 'inildf: 1D eddy viscosity coefficient' 
    3836      IF(lwp) WRITE(numout,*) '~~~~~~  --' 
    39       IF(lwp) WRITE(numout,*) 
    4037 
    4138      ! Set ahm1 for laplacian     (always at t-level) 
    … …  
    124121      ENDIF 
    125122 9120 FORMAT('  jk      ahm       ','  depth w-level ' ) 
    126  
     123      ! 
    127124   END SUBROUTINE ldf_dyn_c1d 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c2d.h90

    r2633 r2690  
    3232      !! 
    3333      !!---------------------------------------------------------------------- 
    34       !! * Arguments 
    3534      LOGICAL, INTENT (in) :: ld_print   ! If true, output arrays on numout 
    36  
    37       !! * Local variables 
    38       INTEGER :: ji, jj 
     35      ! 
     36      INTEGER  ::   ji, jj 
    3937      REAL(wp) ::   za00, zd_max, zetmax, zeumax, zefmax, zevmax 
    4038      !!---------------------------------------------------------------------- 
    … …  
    4341      IF(lwp) WRITE(numout,*) 'ldf_dyn_c2d : 2d lateral eddy viscosity coefficient' 
    4442      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
    45       IF(lwp) WRITE(numout,*) 
    4643 
    4744      ! harmonic operator (ahm1, ahm2) : ( T- and F- points) (used for laplacian operators 
    … …  
    123120         ENDIF 
    124121      ENDIF 
    125  
    126  
     122      ! 
    127123   END SUBROUTINE ldf_dyn_c2d 
    128124 
    … …  
    143139      !! 
    144140      !!---------------------------------------------------------------------- 
    145       !! * Modules used 
    146       USE ldftra_oce, ONLY : aht0 
    147       USE wrk_nemo, ONLY: iwrk_in_use, iwrk_not_released 
    148       USE wrk_nemo, ONLY: icof => iwrk_2d_1 
    149       !! * Arguments 
     141      USE ldftra_oce, ONLY:   aht0 
     142      USE wrk_nemo  , ONLY:   iwrk_in_use, iwrk_not_released 
     143      USE wrk_nemo  , ONLY:   icof => iwrk_2d_1 
     144      ! 
    150145      LOGICAL, INTENT (in) ::   ld_print   ! If true, output arrays on numout 
    151  
    152       !! * Local variables 
    153       INTEGER ::   ji, jj, jn      ! dummy loop indices 
    154       INTEGER ::   inum            ! temporary logical unit 
    155       INTEGER ::   iim, ijm 
    156       INTEGER ::   ifreq, il1, il2, ij, ii 
     146      ! 
     147      INTEGER  ::   ji, jj, jn   ! dummy loop indices 
     148      INTEGER  ::   inum, iim, ijm            ! local integers 
     149      INTEGER  ::   ifreq, il1, il2, ij, ii 
     150      REAL(wp) ::   zahmeq, zcoft, zcoff, zmsk 
     151      CHARACTER (len=15) ::   clexp 
    157152      INTEGER, DIMENSION(jpidta,jpidta) ::   idata 
    158  
    159       REAL(wp) ::   zahmeq, zcoft, zcoff, zmsk 
    160  
    161       CHARACTER (len=15) ::   clexp 
    162153      !!---------------------------------------------------------------------- 
    163154 
    164155      IF( iwrk_in_use(2, 1) )THEN 
    165          CALL ctl_stop('ldf_dyn_c2d_orca: ERROR: requested workspace array is unavailable.') 
    166          RETURN 
    167       END IF 
     156         CALL ctl_stop('ldf_dyn_c2d_orca: requested workspace array is unavailable')   ;   RETURN 
     157      ENDIF 
    168158 
    169159      IF(lwp) WRITE(numout,*) 
    170160      IF(lwp) WRITE(numout,*) 'inildf: 2d eddy viscosity coefficient' 
    171161      IF(lwp) WRITE(numout,*) '~~~~~~  --' 
    172       IF(lwp) WRITE(numout,*) 
    173       IF(lwp) WRITE(numout,*) '        orca ocean model' 
    174       IF(lwp) WRITE(numout,*) 
     162      IF(lwp) WRITE(numout,*) '        orca ocean configuration' 
    175163 
    176164#if defined key_antarctic 
    … …  
    293281      ENDIF 
    294282 
    295       IF( iwrk_not_released(2, 1) )THEN 
    296          CALL ctl_stop('ldf_dyn_c2d_orca: ERROR: failed to release workspace array.') 
     283      IF( iwrk_not_released(2, 1) )   CALL ctl_stop('ldf_dyn_c2d_orca: failed to release workspace array') 
    297284      END IF 
    298  
     285      ! 
    299286   END SUBROUTINE ldf_dyn_c2d_orca 
     287 
    300288 
    301289   SUBROUTINE ldf_dyn_c2d_orca_R1( ld_print ) 
    … …  
    314302      !! 
    315303      !!---------------------------------------------------------------------- 
    316       !! * Modules used 
    317       USE ldftra_oce, ONLY : aht0 
    318       USE wrk_nemo, ONLY: iwrk_in_use, iwrk_not_released 
    319       USE wrk_nemo, ONLY: icof => iwrk_2d_1 
    320  
    321       !! * Arguments 
     304      USE ldftra_oce, ONLY:   aht0 
     305      USE wrk_nemo  , ONLY:   iwrk_in_use, iwrk_not_released 
     306      USE wrk_nemo  , ONLY:   icof => iwrk_2d_1 
     307      ! 
    322308      LOGICAL, INTENT (in) ::   ld_print   ! If true, output arrays on numout 
    323  
    324       !! * Local variables 
     309      ! 
    325310      INTEGER ::   ji, jj, jn      ! dummy loop indices 
    326311      INTEGER ::   inum            ! temporary logical unit 
    327312      INTEGER ::   iim, ijm 
    328313      INTEGER ::   ifreq, il1, il2, ij, ii 
     314      REAL(wp) ::   zahmeq, zcoft, zcoff, zmsk, zam20s 
     315      CHARACTER (len=15) ::   clexp 
    329316      INTEGER, DIMENSION(jpidta,jpidta) ::   idata 
    330  
    331       REAL(wp) ::   zahmeq, zcoft, zcoff, zmsk, zam20s 
    332  
    333       CHARACTER (len=15) ::   clexp 
    334       !!---------------------------------------------------------------------- 
    335  
    336       IF( iwrk_in_use(2, 1) )THEN 
    337          CALL ctl_stop('ldf_dyn_c2d_orca_R1: ERROR: requested workspace array is unavailable.') 
    338          RETURN 
    339       END IF 
     317      !!---------------------------------------------------------------------- 
     318 
     319      IF( iwrk_in_use(2, 1) ) THEN 
     320         CALL ctl_stop('ldf_dyn_c2d_orca_R1: requested workspace array is unavailable')   ;   RETURN 
     321      ENDIF 
    340322 
    341323      IF(lwp) WRITE(numout,*) 
    342324      IF(lwp) WRITE(numout,*) 'inildf: 2d eddy viscosity coefficient' 
    343325      IF(lwp) WRITE(numout,*) '~~~~~~  --' 
    344       IF(lwp) WRITE(numout,*) 
    345       IF(lwp) WRITE(numout,*) '        orca_r1 ocean model' 
    346       IF(lwp) WRITE(numout,*) 
     326      IF(lwp) WRITE(numout,*) '        orca_r1 configuration' 
    347327 
    348328#if defined key_antarctic 
    … …  
    472452      ENDIF 
    473453 
    474       IF( iwrk_not_released(2, 1) )THEN 
    475          CALL ctl_stop('ldf_dyn_c2d_orca_R1: ERROR: failed to release workspace array.') 
    476       END IF 
    477  
     454      IF( iwrk_not_released(2, 1) )   CALL ctl_stop('ldf_dyn_c2d_orca_R1: failed to release workspace array') 
     455      ! 
    478456   END SUBROUTINE ldf_dyn_c2d_orca_R1 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c3d.h90

    r2633 r2690  
    2626      !!       ??? explanation of the default is missing 
    2727      !!---------------------------------------------------------------------- 
    28       USE ldftra_oce, ONLY : aht0 
    29       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    30       USE wrk_nemo, ONLY: zcoef => wrk_1d_2 
    31       !! 
    32       LOGICAL, INTENT (in) :: ld_print   ! If true, output arrays on numout 
    33       !! 
    34       INTEGER  ::   ji, jj, jk      ! dummy loop indices 
    35       REAL(wp) ::   & 
    36          zr = 0.2 ,   &  ! maximum of the reduction factor at the bottom ocean 
    37          !               ! ( 0 < zr < 1 ) 
    38          zh = 500.,   &  ! depth of at which start the reduction ( > dept(1) ) 
    39          zd_max   ,   &  ! maximum grid spacing over the global domain 
    40          za00, zc, zd    ! temporary scalars 
    41       REAL(wp) ::        & 
    42          zetmax, zefmax, & 
    43          zeumax, zevmax    
    44       !!---------------------------------------------------------------------- 
    45  
    46       IF(wrk_in_use(1,2))THEN 
    47          CALL ctl_stop('ldf_dyn_c3d: ERROR: requested workspace array unavailable.') 
    48          RETURN 
    49       END IF 
     28      USE ldftra_oce, ONLY :   aht0 
     29      USE wrk_nemo  , ONLY:   wrk_in_use, wrk_not_released 
     30      USE wrk_nemo  , ONLY:   zcoef => wrk_1d_2 
     31      !! 
     32      LOGICAL, INTENT (in) ::   ld_print   ! If true, output arrays on numout 
     33      !! 
     34      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     35      REAL(wp) ::   zr = 0.2     ! maximum of the reduction factor at the bottom ocean ( 0 < zr < 1 ) 
     36      REAL(wp) ::   zh = 500.    ! depth of at which start the reduction ( > dept(1) ) 
     37      REAL(wp) ::   zd_max       ! maximum grid spacing over the global domain 
     38      REAL(wp) ::   za00, zc, zd, zetmax, zefmax, zeumax, zevmax   ! local scalars 
     39      !!---------------------------------------------------------------------- 
     40 
     41      IF( wrk_in_use(1,2) ) THEN 
     42         CALL ctl_stop('ldf_dyn_c3d: requested workspace array unavailable')   ;   RETURN 
     43      ENDIF 
    5044 
    5145      IF(lwp) WRITE(numout,*) 
    … …  
    187181         ENDIF 
    188182      ENDIF 
    189  
    190       IF(wrk_not_released(1,2))THEN 
    191          CALL ctl_stop('ldf_dyn_c3d: ERROR: failed to release workspace array.') 
    192       END IF 
    193  
     183      ! 
     184      IF( wrk_not_released(1,2) )   CALL ctl_stop('ldf_dyn_c3d: failed to release workspace array') 
     185      ! 
    194186   END SUBROUTINE ldf_dyn_c3d 
    195187 
    … …  
    203195      !! ** Method  :   blah blah blah .... 
    204196      !!---------------------------------------------------------------------- 
    205       USE ldftra_oce, ONLY : aht0 
    206       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released, iwrk_in_use, iwrk_not_released 
    207       USE wrk_nemo, ONLY:  icof => iwrk_2d_1 
    208       USE wrk_nemo, ONLY: zahm0 =>  wrk_2d_1 
    209       USE wrk_nemo, ONLY: zcoef =>  wrk_1d_1 
    210       !! 
    211       LOGICAL, INTENT (in) :: ld_print   ! If true, output arrays on numout 
     197      USE ldftra_oce, ONLY:  aht0 
     198      USE wrk_nemo  , ONLY:  wrk_in_use, wrk_not_released, iwrk_in_use, iwrk_not_released 
     199      USE wrk_nemo  , ONLY:   icof => iwrk_2d_1 
     200      USE wrk_nemo  , ONLY:  zahm0 =>  wrk_2d_1 
     201      USE wrk_nemo  , ONLY:  zcoef =>  wrk_1d_1 
     202      !! 
     203      LOGICAL, INTENT(in) ::  ld_print   ! If true, output arrays on numout 
    212204      !! 
    213205      INTEGER ::   ji, jj, jk, jn      ! dummy loop indices 
    214       INTEGER ::   ii0, ii1, ij0, ij1  ! temporary integers 
    215       INTEGER ::   inum                ! temporary logical unit 
    216       INTEGER ::   iim, ijm 
     206      INTEGER ::   ii0, ii1, ij0, ij1  ! local integers 
     207      INTEGER ::   inum, iim, ijm      !  
    217208      INTEGER ::   ifreq, il1, il2, ij, ii 
    218209      INTEGER, DIMENSION(jpidta, jpjdta) ::   idata 
    219210 
    220       REAL(wp) ::   & 
    221          zahmeq, zcoff, zcoft, zmsk,   & ! ??? 
    222          zemax, zemin, zeref, zahmm 
    223  
     211      REAL(wp) ::   zahmeq, zcoff, zcoft, zmsk   ! local scalars 
     212      REAL(wp) ::   zemax , zemin, zeref, zahmm 
    224213      CHARACTER (len=15) ::   clexp 
    225214      !!---------------------------------------------------------------------- 
    226215 
    227       IF( iwrk_in_use(2,1) .OR. wrk_in_use(2,1) .OR. wrk_in_use(1,1) )THEN 
    228          CALL ctl_stop('ldf_dyn_c3d_orca: ERROR: requested workspace arrays are unavailable.') 
    229          RETURN 
    230       END IF 
     216      IF( iwrk_in_use(2,1) .OR. wrk_in_use(2,1) .OR. wrk_in_use(1,1) ) THEN 
     217         CALL ctl_stop('ldf_dyn_c3d_orca: requested workspace arrays are unavailable')   ;   RETURN 
     218      ENDIF 
    231219 
    232220      IF(lwp) WRITE(numout,*) 
    233221      IF(lwp) WRITE(numout,*) 'ldfdyn_c3d_orca : 3D eddy viscosity coefficient' 
    234222      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~' 
    235       IF(lwp) WRITE(numout,*) 
    236       IF(lwp) WRITE(numout,*) '        orca R1, R2 or R4 ocean model' 
    237       IF(lwp) WRITE(numout,*) '  reduced in the surface Eq. strip ' 
    238       IF(lwp) WRITE(numout,*) 
     223      IF(lwp) WRITE(numout,*) '        orca R1, R2 or R4 configuration: reduced in the surface Eq. strip ' 
    239224 
    240225      ! Read 2d integer array to specify western boundary increase in the 
    … …  
    473458      ENDIF 
    474459 
    475       IF( iwrk_not_released(2,1) .OR. wrk_not_released(2,1) .OR. & 
    476            wrk_not_released(1,1) )THEN 
    477          CALL ctl_stop('ldf_dyn_c3d_orca: ERROR: failed to release workspace arrays.') 
    478       END IF 
    479  
     460      IF( iwrk_not_released(2,1) .OR.   & 
     461           wrk_not_released(2,1) .OR.   & 
     462           wrk_not_released(1,1)   ) CALL ctl_stop('ldf_dyn_c3d_orca: failed to release workspace arrays') 
     463      ! 
    480464   END SUBROUTINE ldf_dyn_c3d_orca 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/LDF/ldfeiv.F90

    r2633 r2690  
    5353      !!             - wslpi, wslpj : i- and j-slopes of neutral surfaces at w-points.  
    5454      !!---------------------------------------------------------------------- 
    55       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    56       USE wrk_nemo, ONLY: zn  => wrk_2d_1, zah   => wrk_2d_2, & 
    57                           zhw => wrk_2d_3, zross => wrk_2d_4 
    58       !! 
     55      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     56      USE wrk_nemo, ONLY:   zn  => wrk_2d_1 , zah   => wrk_2d_2   ! 2D workspace 
     57      USE wrk_nemo, ONLY:   zhw => wrk_2d_3 , zross => wrk_2d_4 
     58      ! 
    5959      INTEGER, INTENT(in) ::   kt   ! ocean time-step inedx 
    60       !! 
     60      ! 
    6161      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    6262      REAL(wp) ::   zfw, ze3w, zn2, zf20, zaht, zaht_min      ! temporary scalars 
    6363      !!---------------------------------------------------------------------- 
    6464       
    65       IF(wrk_in_use(2, 1,2,3,4))THEN 
    66          CALL ctl_stop('ldf_eiv: ERROR: requested workspace arrays are unavailable.') 
    67          RETURN 
    68       END IF 
     65      IF( wrk_in_use(2, 1,2,3,4) ) THEN 
     66         CALL ctl_stop('ldf_eiv: requested workspace arrays are unavailable.')   ;   RETURN 
     67      ENDIF 
    6968 
    7069      IF( kt == nit000 ) THEN 
    … …  
    244243      CALL iom_put( "aht2d_eiv", aeiw )   ! EIV lateral eddy diffusivity 
    245244      !   
    246       IF(wrk_not_released(2, 1,2,3,4))THEN 
    247          CALL ctl_stop('ldf_eiv: ERROR: failed to release workspace arrays.') 
    248       END IF 
     245      IF( wrk_not_released(2, 1,2,3,4) )   CALL ctl_stop('ldf_eiv: failed to release workspace arrays') 
    249246      ! 
    250247   END SUBROUTINE ldf_eiv 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90

    r2678 r2690  
    115115      !!               of now neutral surfaces at u-, w- and v- w-points, resp. 
    116116      !!---------------------------------------------------------------------- 
    117       USE oce , zgru  => ua   ! use ua as workspace 
    118       USE oce , zgrv  => va   ! use va as workspace 
    119       USE oce , zww   => ta   ! use ta as workspace 
    120       USE oce , zwz   => sa   ! use sa as workspace 
    121117      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    122       USE wrk_nemo, ONLY: zdzr => wrk_3d_1 
     118      USE oce     , ONLY:   zgru => ua       , zww => va   ! (ua,va) used as workspace 
     119      USE oce     , ONLY:   zgrv => ta       , zwz => sa   ! (ta,sa) used as workspace 
     120      USE wrk_nemo, ONLY:   zdzr => wrk_3d_1               ! 3D workspace 
    123121      !! 
    124122      INTEGER , INTENT(in)                   ::   kt    ! ocean time-step index 
    … …  
    135133      !!---------------------------------------------------------------------- 
    136134 
    137       IF(wrk_in_use(3, 1) ) THEN 
     135      IF( wrk_in_use(3, 1) ) THEN 
    138136         CALL ctl_stop('ldf_slp: requested workspace arrays are unavailable')   ;   RETURN 
    139       END IF 
     137      ENDIF 
    140138 
    141139      zeps   =  1.e-20_wp        !==   Local constant initialization   ==! 
    … …  
    370368      ENDIF 
    371369 
    372        
    373370      ! IV. Lateral boundary conditions  
    374371      ! =============================== 
    … …  
    382379      ENDIF 
    383380      ! 
    384       IF(wrk_not_released(3, 1))THEN 
    385          CALL ctl_stop('ldf_slp: ERROR: failed to release workspace arrays.') 
    386       END IF 
     381      IF( wrk_not_released(3, 1) )   CALL ctl_stop('ldf_slp: failed to release workspace arrays') 
    387382      ! 
    388383   END SUBROUTINE ldf_slp 
    … …  
    403398      !!             - wslp2              squared slope of neutral surfaces at w-points. 
    404399      !!---------------------------------------------------------------------- 
    405       USE oce,   zdit  => ua   ! use ua as workspace 
    406       USE oce,   zdis  => va   ! use va as workspace 
    407       USE oce,   zdjt  => ta   ! use ta as workspace 
    408       USE oce,   zdjs  => sa   ! use sa as workspace 
    409       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    410       USE wrk_nemo, ONLY: zdkt   => wrk_3d_2, zdks  => wrk_3d_3, & 
    411                           zalpha => wrk_3d_4, zbeta => wrk_3d_5    ! alpha, beta at T points, at depth fsgdept 
    412       USE wrk_nemo, ONLY: z1_mlbw => wrk_2d_1 
    413       !! 
    414       INTEGER, INTENT( in ) ::   kt         ! ocean time-step index 
    415       !! 
     400      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     401      USE oce     , ONLY:   zdit    => ua       , zdis   => va         ! (ua,va) used as workspace 
     402      USE oce     , ONLY:   zdjt    => ta       , zdjs   => sa         ! (ta,sa) used as workspace 
     403      USE wrk_nemo, ONLY:   zdkt    => wrk_3d_2 , zdks   => wrk_3d_3   ! 3D workspace 
     404      USE wrk_nemo, ONLY:   zalpha  => wrk_3d_4 , zbeta => wrk_3d_5    ! alpha, beta at T points, at depth fsgdept 
     405      USE wrk_nemo, ONLY:   z1_mlbw => wrk_2d_1 
     406      ! 
     407      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
     408      ! 
    416409      INTEGER  ::   ji, jj, jk, jl, ip, jp, kp  ! dummy loop indices 
    417       INTEGER  ::   iku, ikv                ! temporary integer 
     410      INTEGER  ::   iku, ikv                                  ! local integer 
    418411      REAL(wp) ::   zfacti, zfactj, zatempw,zatempu,zatempv   ! local scalars 
    419       REAL(wp) ::   zbu, zbv, zbti, zbtj 
     412      REAL(wp) ::   zbu, zbv, zbti, zbtj                      !   -      - 
    420413      REAL(wp) ::   zdxrho_raw, zti_coord, zti_raw, zti_lim, zti_lim2, zti_g_raw, zti_g_lim 
    421414      REAL(wp) ::   zdyrho_raw, ztj_coord, ztj_raw, ztj_lim, ztj_lim2, ztj_g_raw, ztj_g_lim 
    … …  
    423416      !!---------------------------------------------------------------------- 
    424417 
    425       IF( (wrk_in_use(3, 2,3,4,5)) .OR. (wrk_in_use(2, 1)) )THEN 
    426          CALL ctl_stop('ldf_slp_grif: ERROR: requested workspace arrays are unavailable.')   ;   RETURN 
    427       END IF 
     418      IF( wrk_in_use(3, 2,3,4,5) .OR. wrk_in_use(2, 1) )THEN 
     419         CALL ctl_stop('ldf_slp_grif: requested workspace arrays are unavailable')   ;   RETURN 
     420      ENDIF 
    428421 
    429422      !--------------------------------! 
    … …  
    607600      CALL lbc_lnk( wslp2, 'W', 1. )      ! lateral boundary confition on wslp2 only   ==>>> gm : necessary ? to be checked 
    608601      ! 
    609       IF(wrk_not_released(3, 2,3,4,5) .OR.   & 
    610          wrk_not_released(2, 1)        )   CALL ctl_stop('ldf_slp_grif: ERROR: failed to release workspace arrays.') 
     602      IF( wrk_not_released(3, 2,3,4,5) .OR.   & 
     603          wrk_not_released(2, 1)       )   CALL ctl_stop('ldf_slp_grif: failed to release workspace arrays') 
    611604      ! 
    612605   END SUBROUTINE ldf_slp_grif 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra.F90

    r2528 r2690  
    3636   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    3737   !! $Id$ 
    38    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     38   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3939   !!---------------------------------------------------------------------- 
    40  
    4140CONTAINS 
    4241 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_c1d.h90

    r2528 r2690  
    66   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    77   !! $Id$  
    8    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     8   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    99   !!---------------------------------------------------------------------- 
    1010 
    … …  
    2828      !!         always harmonic      : aeiu = aeiv defined at T-level 
    2929      !!            aeiw defined at w-level 
    30       !! 
    3130      !!---------------------------------------------------------------------- 
    32       !! * Arguments 
    33       LOGICAL, INTENT (in) :: ld_print   ! If true, print arrays in numout 
    34  
    35       !! * Local variables 
    36       INTEGER ::   jk                  ! dummy loop indices 
    37       REAL(wp) ::   & 
    38          zkah, zahr, za00 , za01,   &  ! temporary scalars 
    39          zahf, zahs, zahtf, zahts 
     31      LOGICAL, INTENT (in) ::   ld_print   ! If true, print arrays in numout 
     32      ! 
     33      INTEGER  ::   jk   ! dummy loop indices 
     34      REAL(wp) ::   zkah, zahr, za00 , za01    ! local scalars 
     35      REAL(wp) ::   zahf, zahs, zahtf, zahts   !   -      - 
    4036      !!---------------------------------------------------------------------- 
    4137 
    … …  
    130126      ENDIF 
    131127#endif 
    132  
     128      ! 
    133129   END SUBROUTINE ldf_tra_c1d 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_c2d.h90

    r2528 r2690  
    2525      !!       eddy induced velocity 
    2626      !!           always harmonic   : aeiu, aeiv, aeiw defined at u-, v-, w-pts 
    27       !! 
    2827      !!---------------------------------------------------------------------- 
    29       !! * Arguments 
    30       LOGICAL, INTENT (in) :: ld_print   ! If true, print arrays in numout 
    31  
    32       !! * Local variables 
    33       INTEGER ::   ji, jj                  ! dummy loop indices 
     28      LOGICAL, INTENT (in) ::   ld_print   ! If true, print arrays in numout 
     29      ! 
     30      INTEGER ::   ji, jj   ! dummy loop indices 
    3431# if defined key_orca_r4 
    3532      INTEGER :: i1, i2, j1, j2 
    3633# endif 
    3734      REAL(wp) ::   za00, zd_max, zeumax, zevmax, zetmax 
    38        
    3935      !!---------------------------------------------------------------------- 
    4036 
    … …  
    4339         IF(lwp) WRITE(numout,*) ' ldf_tra_c2d : 2D eddy diffusivity and eddy' 
    4440         IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~   --  induced velocity coefficients' 
    45          IF(lwp) WRITE(numout,*) 
    4641      ELSE 
    4742         IF(lwp) WRITE(numout,*) 
    4843         IF(lwp) WRITE(numout,*) ' ldf_tra2d : 2D eddy diffusivity coefficient' 
    4944         IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~   --' 
    50          IF(lwp) WRITE(numout,*) 
    5145      ENDIF 
    5246 
    … …  
    5751      ! ================== 
    5852      IF( ln_traldf_lap ) THEN 
    59    
     53         ! 
    6054         za00 = aht0 / zd_max 
    61    
     55         ! 
    6256         DO jj = 1, jpj  
    6357            DO ji = 1, jpi  
    … …  
    167161         CALL prihre(aeiw,jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout) 
    168162      ENDIF 
    169  
    170163# endif 
    171  
     164      ! 
    172165   END SUBROUTINE ldf_tra_c2d 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_c3d.h90

    r2528 r2690  
    66   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    77   !! $Id$  
    8    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     8   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    99   !!---------------------------------------------------------------------- 
    1010 
    … …  
    2929      !!       eddy induced velocity 
    3030      !!         always harmonic   : aeiu, aeiv, aeiw defined at u-, v-, w-pts 
    31       !! 
    3231      !!---------------------------------------------------------------------- 
    33       !! * Modules used 
    3432      USE ioipsl 
    35  
    36       !! * Arguments 
    37       LOGICAL, INTENT (in) :: ld_print   ! If true, output arrays on numout 
    38  
     33      ! 
     34      LOGICAL, INTENT (in) ::   ld_print   ! If true, output arrays on numout 
    3935      !!---------------------------------------------------------------------- 
    4036 
    … …  
    4440         IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~   --  ' 
    4541         IF(lwp) WRITE(numout,*) '               Coefficients set to constant' 
    46          IF(lwp) WRITE(numout,*) 
    4742      ELSE 
    4843         IF(lwp) WRITE(numout,*) 
    … …  
    5045         IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~   -- ' 
    5146         IF(lwp) WRITE(numout,*) '               Coefficients set to constant' 
    52          IF(lwp) WRITE(numout,*) 
    5347      ENDIF 
    5448 
    … …  
    127121         CALL prihre(aeiw(:,:,1),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout) 
    128122      ENDIF 
    129  
    130 END SUBROUTINE ldf_tra_c3d 
     123      ! 
     124   END SUBROUTINE ldf_tra_c3d 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_oce.F90

    r2636 r2690  
    9191      ALLOCATE( ahtt(jpi,jpj,jpk) , ahtu(jpi,jpj,jpk) , ahtv(jpi,jpj,jpk) , ahtw(jpi,jpj,jpk) , STAT=ierr(1) ) 
    9292#elif defined key_traldf_c2d 
    93       ALLOCATE( ahtt(jpi,jpj     ), ahtu(jpi,jpj)    , ahtv(jpi,jpj    ) , ahtw(jpi,jpj    ) , STAT=ierr(1) ) 
     93      ALLOCATE( ahtt(jpi,jpj    ) , ahtu(jpi,jpj    ) , ahtv(jpi,jpj    ) , ahtw(jpi,jpj    ) , STAT=ierr(1) ) 
    9494#elif defined key_traldf_c1d 
    95       ALLOCATE( ahtt(         jpk) , ahtu(       jpk) , ahtv(        jpk) , ahtw(        jpk) , STAT=ierr(1) ) 
     95      ALLOCATE( ahtt(        jpk) , ahtu(        jpk) , ahtv(        jpk) , ahtw(        jpk) , STAT=ierr(1) ) 
    9696#endif 
    9797      ! 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/OBC/obcdyn_bt.F90

    r2618 r2690  
    11MODULE obcdyn_bt 
     2   !!====================================================================== 
     3   !!                       ***  MODULE  obcdyn_bt  *** 
     4   !! Ocean dynamics:   Radiation/prescription of sea surface heights on each open boundary 
     5   !!====================================================================== 
     6   !! History :  1.0  ! 2005-12  (V. Garnier) original code 
     7   !!---------------------------------------------------------------------- 
    28#if ( defined key_dynspg_ts || defined key_dynspg_exp ) && defined key_obc 
    3    !!================================================================================= 
    4    !!                       ***  MODULE  obcdyn_bt  *** 
    5    !! Ocean dynamics:   Radiation/prescription of sea surface heights 
    6    !!                   on each open boundary 
    7    !!================================================================================= 
    8  
    9    !!--------------------------------------------------------------------------------- 
     9   !!---------------------------------------------------------------------- 
     10   !!   'key_dynspg_ts'     OR                   time spliting free surface 
     11   !!   'key_dynspg_exp'    AND                       explicit free surface 
     12   !!   'key_obc'                                   Open Boundary Condition 
     13   !!---------------------------------------------------------------------- 
    1014   !!   obc_dyn_bt        : call the subroutine for each open boundary 
    1115   !!   obc_dyn_bt_east   : Flather's algorithm at the east open boundary 
    … …  
    1317   !!   obc_dyn_bt_north  : Flather's algorithm at the north open boundary 
    1418   !!   obc_dyn_bt_south  : Flather's algorithm at the south open boundary 
    15    !!---------------------------------------------------------------------------------- 
    16  
    17    !!---------------------------------------------------------------------------------- 
     19   !!---------------------------------------------------------------------- 
    1820   USE oce             ! ocean dynamics and tracers  
    1921   USE dom_oce         ! ocean space and time domain 
    … …  
    2931   PRIVATE 
    3032 
    31    !! * Accessibility 
    32    PUBLIC obc_dyn_bt  ! routine called in dynnxt (explicit free surface case) 
    33  
    34    !!--------------------------------------------------------------------------------- 
     33   PUBLIC   obc_dyn_bt  ! routine called in dynnxt (explicit free surface case) 
     34 
     35   !!---------------------------------------------------------------------- 
    3536   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    3637   !! $Id$  
    37    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    38    !!---------------------------------------------------------------------- 
    39  
     38   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     39   !!---------------------------------------------------------------------- 
    4040CONTAINS 
    4141 
    4242   SUBROUTINE obc_dyn_bt( kt ) 
    43       !!------------------------------------------------------------------------------ 
    44       !!                      SUBROUTINE obc_dyn_bt 
    45       !!                     *********************** 
    46       !! ** Purpose : 
    47       !!      Apply Flather's algorithm at open boundaries for the explicit 
    48       !!      free surface case and free surface case with time-splitting 
     43      !!---------------------------------------------------------------------- 
     44      !!                 ***  SUBROUTINE obc_dyn_bt  *** 
     45      !! 
     46      !! ** Purpose :   Apply Flather's algorithm at open boundaries for the explicit 
     47      !!              free surface case and free surface case with time-splitting 
    4948      !! 
    5049      !!      This routine is called in dynnxt.F routine and updates ua, va and sshn.  
    … …  
    5453      !!      open one (must be done in the param_obc.h90 file). 
    5554      !! 
    56       !! ** Reference :   Flather, R. A., 1976, Mem. Soc. R. Sci. Liege, Ser. 6, 10, 141-164 
    57       !! 
    58       !! History :  9.0  !  05-12  (V. Garnier) original  
    59       !!---------------------------------------------------------------------- 
    60       !! * Arguments 
    61       INTEGER, INTENT( in ) ::   kt 
    62  
     55      !! Reference :   Flather, R. A., 1976, Mem. Soc. R. Sci. Liege, Ser. 6, 10, 141-164 
     56      !!---------------------------------------------------------------------- 
     57      INTEGER, INTENT(in) ::   kt 
    6358      !!---------------------------------------------------------------------- 
    6459 
    … …  
    8277 
    8378# if defined key_dynspg_exp 
     79 
    8480   SUBROUTINE obc_dyn_bt_east  
    85       !!------------------------------------------------------------------------------ 
     81      !!---------------------------------------------------------------------- 
    8682      !!                  ***  SUBROUTINE obc_dyn_bt_east  *** 
    8783      !!               
    … …  
    9086      !!      Fix sea surface height (sshn) on east open boundary 
    9187      !!      The logical lfbceast must be .TRUE. 
    92       !! 
    93       !!  History : 
    94       !!   9.0  !  05-12  (V. Garnier) original 
    95       !!------------------------------------------------------------------------------ 
    96       !! * Local declaration 
    97       INTEGER ::   ji, jj, jk ! dummy loop indices 
    98       !!------------------------------------------------------------------------------ 
     88      !!---------------------------------------------------------------------- 
     89      INTEGER, INTENT(in) ::   kt 
     90      !!---------------------------------------------------------------------- 
     91      INTEGER ::   ji, jj, jk   ! dummy loop indices 
     92      !!---------------------------------------------------------------------- 
    9993 
    10094      DO ji = nie0, nie1 
    … …  
    117111 
    118112   SUBROUTINE obc_dyn_bt_west  
    119       !!------------------------------------------------------------------------------ 
     113      !!---------------------------------------------------------------------- 
    120114      !!                  ***  SUBROUTINE obc_dyn_bt_west  *** 
    121115      !!                   
    … …  
    124118      !!      Fix sea surface height (sshn) on west open boundary 
    125119      !!      The logical lfbcwest must be .TRUE. 
    126       !! 
    127       !!  History : 
    128       !!   9.0  !  05-12  (V. Garnier) original 
    129       !!------------------------------------------------------------------------------ 
    130       !! * Local declaration 
    131       INTEGER ::   ji, jj, jk ! dummy loop indices 
    132       !!------------------------------------------------------------------------------ 
    133  
     120      !!---------------------------------------------------------------------- 
     121      INTEGER ::   ji, jj, jk   ! dummy loop indices 
     122      !!---------------------------------------------------------------------- 
     123      ! 
    134124      DO ji = niw0, niw1 
    135125         DO jk = 1, jpkm1 
    … …  
    144134         END DO 
    145135      END DO 
    146  
     136      ! 
    147137   END SUBROUTINE obc_dyn_bt_west 
     138 
    148139 
    149140   SUBROUTINE obc_dyn_bt_north  
    … …  
    155146      !!      Fix sea surface height (sshn) on north open boundary 
    156147      !!      The logical lfbcnorth must be .TRUE. 
    157       !! 
    158       !!  History : 
    159       !!   9.0  !  05-12  (V. Garnier) original 
    160       !!------------------------------------------------------------------------------ 
    161       !! * Local declaration 
    162       INTEGER ::   ji, jj, jk ! dummy loop indices 
    163       !!------------------------------------------------------------------------------ 
    164  
     148      !!---------------------------------------------------------------------- 
     149      INTEGER ::   ji, jj, jk   ! dummy loop indices 
     150      !!---------------------------------------------------------------------- 
     151      ! 
    165152      DO jj = njn0, njn1 
    166153         DO jk = 1, jpkm1 
    … …  
    177164         END DO 
    178165      END DO 
    179  
     166      ! 
    180167   END SUBROUTINE obc_dyn_bt_north 
    181168 
     169 
    182170   SUBROUTINE obc_dyn_bt_south  
    183       !!------------------------------------------------------------------------------ 
     171      !!---------------------------------------------------------------------- 
    184172      !!                ***  SUBROUTINE obc_dyn_bt_south  *** 
    185173      !!                     
    … …  
    188176      !!      Fix sea surface height (sshn) on south open boundary 
    189177      !!      The logical lfbcsouth must be .TRUE. 
    190       !! 
    191       !!  History : 
    192       !!   9.0  !  05-12  (V. Garnier) original 
    193       !!------------------------------------------------------------------------------ 
    194       !! * Local declaration 
    195       INTEGER ::   ji, jj, jk ! dummy loop indices 
    196  
    197       !!------------------------------------------------------------------------------ 
    198  
     178      !!---------------------------------------------------------------------- 
     179      INTEGER ::   ji, jj, jk   ! dummy loop indices 
     180      !!---------------------------------------------------------------------- 
     181      ! 
    199182      DO jj = njs0, njs1 
    200183         DO jk = 1, jpkm1 
    … …  
    209192         END DO 
    210193      END DO 
    211  
     194      ! 
    212195   END SUBROUTINE obc_dyn_bt_south 
    213196 
    … …  
    222205      !!      Fix sea surface height (sshn) on east open boundary 
    223206      !!      The logical lfbceast must be .TRUE. 
    224       !! 
    225       !!  History : 
    226       !!   9.0  !  05-12  (V. Garnier) original 
    227       !!------------------------------------------------------------------------------ 
    228       !! * Local declaration 
    229       INTEGER ::   ji, jj, jk ! dummy loop indices 
    230       !!------------------------------------------------------------------------------ 
    231  
     207      !!---------------------------------------------------------------------- 
     208      INTEGER ::   ji, jj, jk   ! dummy loop indices 
     209      !!---------------------------------------------------------------------- 
     210      ! 
    232211      DO ji = nie0, nie1 
    233212         DO jk = 1, jpkm1 
    … …  
    242221         END DO 
    243222      END DO 
    244  
     223      ! 
    245224   END SUBROUTINE obc_dyn_bt_east 
    246225 
     226 
    247227   SUBROUTINE obc_dyn_bt_west  
    248       !!------------------------------------------------------------------------------ 
     228      !!--------------------------------------------------------------------- 
    249229      !!                  ***  SUBROUTINE obc_dyn_bt_west  *** 
    250230      !! 
    251       !! ** Purpose : 
    252       !! ** Purpose : 
    253       !!      Apply Flather algorithm on west OBC velocities ua, va 
     231      !! ** Purpose :   Apply Flather algorithm on west OBC velocities ua, va 
    254232      !!      Fix sea surface height (sshn) on west open boundary 
    255233      !!      The logical lfbcwest must be .TRUE. 
    256       !! 
    257       !!  History : 
    258       !!   9.0  !  05-12  (V. Garnier) original 
    259       !!------------------------------------------------------------------------------ 
    260       !! * Local declaration 
    261       INTEGER ::   ji, jj, jk ! dummy loop indices 
    262       !!------------------------------------------------------------------------------ 
    263  
     234      !!---------------------------------------------------------------------- 
     235      INTEGER ::   ji, jj, jk   ! dummy loop indices 
     236      !!---------------------------------------------------------------------- 
     237      ! 
    264238      DO ji = niw0, niw1 
    265239         DO jk = 1, jpkm1 
    … …  
    272246         END DO 
    273247      END DO 
    274  
     248      ! 
    275249   END SUBROUTINE obc_dyn_bt_west 
     250 
    276251 
    277252   SUBROUTINE obc_dyn_bt_north  
    278253      !!------------------------------------------------------------------------------ 
    279       !!                     SUBROUTINE obc_dyn_bt_north 
    280       !!                    ************************* 
     254      !!                ***  SUBROUTINE obc_dyn_bt_north  *** 
     255      !!                 
    281256      !! ** Purpose : 
    282257      !!      Apply Flather algorithm on north OBC velocities ua, va 
    283258      !!      Fix sea surface height (sshn) on north open boundary 
    284259      !!      The logical lfbcnorth must be .TRUE. 
    285       !! 
    286       !!  History : 
    287       !!   9.0  !  05-12  (V. Garnier) original 
    288       !!------------------------------------------------------------------------------ 
    289       !! * Local declaration 
    290       INTEGER ::   ji, jj, jk ! dummy loop indices 
    291       !!------------------------------------------------------------------------------ 
    292  
     260      !!---------------------------------------------------------------------- 
     261      INTEGER ::   ji, jj, jk   ! dummy loop indices 
     262      !!---------------------------------------------------------------------- 
     263      ! 
    293264      DO jj = njn0, njn1 
    294265         DO jk = 1, jpkm1 
    … …  
    303274         END DO 
    304275      END DO 
    305  
     276      ! 
    306277   END SUBROUTINE obc_dyn_bt_north 
     278 
    307279 
    308280   SUBROUTINE obc_dyn_bt_south  
    309281      !!------------------------------------------------------------------------------ 
    310       !!                     SUBROUTINE obc_dyn_bt_south 
    311       !!                    ************************* 
     282      !!                ***  SUBROUTINE obc_dyn_bt_south  *** 
     283      !!                   
    312284      !! ** Purpose : 
    313285      !!      Apply Flather algorithm on south OBC velocities ua, va 
    314286      !!      Fix sea surface height (sshn) on south open boundary 
    315287      !!      The logical lfbcsouth must be .TRUE. 
    316       !! 
    317       !!  History : 
    318       !!   9.0  !  05-12  (V. Garnier) original 
    319       !!------------------------------------------------------------------------------ 
    320       INTEGER ::   ji, jj, jk ! dummy loop indices 
    321       !!------------------------------------------------------------------------------ 
    322  
     288      !!---------------------------------------------------------------------- 
     289      INTEGER ::   ji, jj, jk   ! dummy loop indices 
     290      !!---------------------------------------------------------------------- 
     291      ! 
    323292      DO jj = njs0, njs1 
    324293         DO jk = 1, jpkm1 
    … …  
    331300         END DO 
    332301      END DO 
    333  
     302      ! 
    334303   END SUBROUTINE obc_dyn_bt_south 
    335304 
    336305# endif 
     306 
    337307#else 
    338    !!================================================================================= 
    339    !!                       ***  MODULE  obcdyn_bt  *** 
    340    !! Ocean dynamics:   Radiation of velocities on each open boundary 
    341    !!================================================================================= 
     308   !!---------------------------------------------------------------------- 
     309   !!   Default option       No Open Boundaries or not explicit fre surface 
     310   !!---------------------------------------------------------------------- 
    342311CONTAINS 
    343  
    344    SUBROUTINE obc_dyn_bt 
    345                               ! No open boundaries ==> empty routine 
     312   SUBROUTINE obc_dyn_bt      ! Dummy routine 
    346313   END SUBROUTINE obc_dyn_bt 
    347314#endif 
    348315 
     316   !!====================================================================== 
    349317END MODULE obcdyn_bt 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/OBC/obcfla.F90

    r2618 r2690  
    88   !!            4.0  ! 2011-02  (G. Madec) velocity & ssh passed in argument 
    99   !!---------------------------------------------------------------------- 
    10 #if defined key_obc && defined key_dynspg_ts 
     10#if defined key_obc   &&  defined key_dynspg_ts 
    1111   !!---------------------------------------------------------------------- 
    1212   !!   'key_obc'          and                      Open Boundary Condition 
    … …  
    7575      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   p_sshn, p_ssha   ! before, now, after sea surface height 
    7676      ! 
    77       INTEGER ::   ji, jj ! dummy loop indices 
     77      INTEGER ::   ji, jj   ! dummy loop indices 
    7878      !!---------------------------------------------------------------------- 
    7979      ! 
    … …  
    106106      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   p_sshn, p_ssha   ! before, now, after sea surface height 
    107107      ! 
    108       INTEGER ::   ji, jj ! dummy loop indices 
     108      INTEGER ::   ji, jj   ! dummy loop indices 
    109109      !!---------------------------------------------------------------------- 
    110110      ! 
    … …  
    133133      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   p_sshn, p_ssha   ! before, now, after sea surface height 
    134134      ! 
    135       INTEGER ::   ji, jj ! dummy loop indices 
     135      INTEGER ::   ji, jj   ! dummy loop indices 
    136136      !!---------------------------------------------------------------------- 
    137137      ! 
    … …  
    164164      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   p_sshn, p_ssha   ! before, now, after sea surface height 
    165165      ! 
    166       INTEGER ::   ji, jj ! dummy loop indices 
     166      INTEGER ::   ji, jj   ! dummy loop indices 
    167167      !!---------------------------------------------------------------------- 
    168168      ! 
    … …  
    185185   !!---------------------------------------------------------------------- 
    186186CONTAINS 
    187  
    188187   SUBROUTINE obc_fla_ts( pua, pva, p_sshn, p_ssha ) 
    189188      REAL, DIMENSION(:,:)::   pua, pva, p_sshn, p_ssha 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC/albedo.F90

    r2640 r2690  
    6666      !!---------------------------------------------------------------------- 
    6767      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    68       USE wrk_nemo, ONLY:   wrk_3d_6, wrk_3d_7    ! 3D workspace 
     68      USE wrk_nemo, ONLY:   wrk_3d_6 , wrk_3d_7    ! 3D workspace 
    6969      !! 
    7070      REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   pt_ice      !  ice surface temperature (Kelvin) 
    … …  
    187187      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pa_oce_cs   !  albedo of ocean under clear sky 
    188188      !! 
    189       REAL(wp) ::   zcoef   ! temporary scalar 
     189      REAL(wp) ::   zcoef   ! local scalar 
    190190      !!---------------------------------------------------------------------- 
    191191      ! 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90

    r2620 r2690  
    3232   USE dom_oce                      ! ocean space and time domain 
    3333   USE in_out_manager               ! I/O manager 
    34    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
     34   USE lbclnk                       ! ocean lateral boundary conditions (or mpp link) 
    3535 
    3636   IMPLICIT NONE 
    3737   PRIVATE 
    3838 
    39    PUBLIC cpl_prism_init 
    40    PUBLIC cpl_prism_define 
    41    PUBLIC cpl_prism_snd 
    42    PUBLIC cpl_prism_rcv 
    43    PUBLIC cpl_prism_freq 
    44    PUBLIC cpl_prism_finalize 
    45  
    46    LOGICAL, PUBLIC, PARAMETER :: lk_cpl = .TRUE.   !: coupled flag 
    47    INTEGER, PUBLIC            :: OASIS_Rcv  = 1    !: return code if received field 
    48    INTEGER, PUBLIC            :: OASIS_idle = 0    !: return code if nothing done by oasis 
    49    INTEGER                    :: ncomp_id          ! id returned by prism_init_comp 
    50    INTEGER                    :: nerror            ! return error code 
    51  
    52    INTEGER, PARAMETER :: nmaxfld=40    ! Maximum number of coupling fields 
     39   PUBLIC   cpl_prism_init 
     40   PUBLIC   cpl_prism_define 
     41   PUBLIC   cpl_prism_snd 
     42   PUBLIC   cpl_prism_rcv 
     43   PUBLIC   cpl_prism_freq 
     44   PUBLIC   cpl_prism_finalize 
     45 
     46   LOGICAL, PUBLIC, PARAMETER ::   lk_cpl = .TRUE.   !: coupled flag 
     47   INTEGER, PUBLIC            ::   OASIS_Rcv  = 1    !: return code if received field 
     48   INTEGER, PUBLIC            ::   OASIS_idle = 0    !: return code if nothing done by oasis 
     49   INTEGER                    ::   ncomp_id          ! id returned by prism_init_comp 
     50   INTEGER                    ::   nerror            ! return error code 
     51 
     52   INTEGER, PARAMETER ::   nmaxfld=40    ! Maximum number of coupling fields 
    5353    
    5454   TYPE, PUBLIC ::   FLD_CPL            !: Type for coupling field information 
    … …  
    6060   END TYPE FLD_CPL 
    6161 
    62    TYPE(FLD_CPL), DIMENSION(nmaxfld), PUBLIC :: srcv, ssnd   !: Coupling fields 
    63  
    64    REAL(wp), DIMENSION(:,:), ALLOCATABLE :: exfld  ! Temporary buffer for receiving 
     62   TYPE(FLD_CPL), DIMENSION(nmaxfld), PUBLIC ::   srcv, ssnd   !: Coupling fields 
     63 
     64   REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   exfld   ! Temporary buffer for receiving 
    6565 
    6666   !!---------------------------------------------------------------------- 
    … …  
    243243      INTEGER                 , INTENT(  out) ::   kinfo     ! OASIS3 info argument 
    244244      !! 
    245       LOGICAL                :: llaction 
     245      LOGICAL ::  llaction 
    246246      !!-------------------------------------------------------------------- 
    247247      ! 
    … …  
    284284 
    285285 
    286    FUNCTION cpl_prism_freq( kid )   
     286   INTEGER FUNCTION cpl_prism_freq( kid )   
    287287      !!--------------------------------------------------------------------- 
    288288      !!              ***  ROUTINE cpl_prism_freq  *** 
    … …  
    290290      !! ** Purpose : - send back the coupling frequency for a particular field 
    291291      !!---------------------------------------------------------------------- 
    292       INTEGER,INTENT( IN )   :: kid              ! variable index  
    293       INTEGER                :: cpl_prism_freq   ! coupling frequency 
     292      INTEGER,INTENT(in) ::   kid   ! variable index  
    294293      !!---------------------------------------------------------------------- 
    295294      cpl_prism_freq = ig_def_freq( kid ) 
    … …  
    307306      !!---------------------------------------------------------------------- 
    308307      ! 
    309       DEALLOCATE(exfld) 
    310       CALL prism_terminate_proto ( nerror )          
     308      DEALLOCATE( exfld ) 
     309      CALL prism_terminate_proto( nerror )          
    311310      ! 
    312311   END SUBROUTINE cpl_prism_finalize 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90

    r2636 r2690  
    822822      ! 
    823823      IF(  wrk_in_use(2, 1)  .OR.  iwrk_in_use(2,1) ) THEN 
    824          CALL ctl_stop('fld_weights: requested workspace arrays are unavailable.')   ;   RETURN 
     824         CALL ctl_stop('fld_weights: requested workspace arrays are unavailable')   ;   RETURN 
    825825      ENDIF 
    826826      ! 
    … …  
    936936 
    937937      IF(  wrk_not_released(2, 1) .OR.    & 
    938           iwrk_not_released(2, 1)   )   CALL ctl_stop('fld_weights: failed to release workspace arrays') 
     938          iwrk_not_released(2, 1)  )   CALL ctl_stop('fld_weights: failed to release workspace arrays') 
    939939      ! 
    940940   END SUBROUTINE fld_weight 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC/geo2ocean.F90

    r2636 r2690  
    513513      !!   8.5  !  02-08  (G. Madec)  F90: Free form 
    514514      !!---------------------------------------------------------------------- 
    515       !! * Arguments 
    516       REAL(wp), INTENT( IN   ), DIMENSION(jpi,jpj) ::   & 
    517          px1, py1          ! two horizontal components to be rotated 
    518       REAL(wp), INTENT( OUT  ), DIMENSION(jpi,jpj) ::   & 
    519          px2, py2          ! the two horizontal components in the model repere 
    520       INTEGER, INTENT( IN ) ::   & 
    521          kchoix   ! type of transformation 
    522                   ! = 1 change from geographic to model grid. 
    523                   ! =-1 change from model to geographic grid 
    524       CHARACTER(len=1), INTENT( IN ), OPTIONAL ::   cd_type      ! define the nature of pt2d array grid-points 
     515      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   px1, py1   ! two horizontal components to be rotated 
     516      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   px2, py2   ! the two horizontal components in the model repere 
     517      INTEGER , INTENT(in   )                     ::   kchoix     ! type of transformation 
     518      !                                                           ! = 1 change from geographic to model grid. 
     519      !                                                           ! =-1 change from model to geographic grid 
     520      CHARACTER(len=1), INTENT(in   ), OPTIONAL   ::   cd_type    ! define the nature of pt2d array grid-points 
    525521      ! 
    526522      CHARACTER(len=1) ::   cl_type      ! define the nature of pt2d array grid-points (T point by default) 
    … …  
    554550      !!   9.2  !  09-02  (K. Mogensen) 
    555551      !!---------------------------------------------------------------------- 
    556       REAL(wp), DIMENSION(jpi,jpj), INTENT( OUT )::   & 
    557          & psinu, pcosu, psinv, pcosv! copy of data 
     552      REAL(wp), DIMENSION(jpi,jpj), INTENT( OUT )::   psinu, pcosu, psinv, pcosv   ! copy of data 
    558553      !!---------------------------------------------------------------------- 
    559554 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90

    r2620 r2690  
    7777         &      utau_ice(jpi,jpj)     , vtau_ice(jpi,jpj)     ,     & 
    7878         &      fr1_i0  (jpi,jpj)     , fr2_i0  (jpi,jpj)     ,     & 
    79          &      emp_ice(jpi,jpj)                              , STAT=sbc_ice_alloc ) 
     79         &      emp_ice(jpi,jpj)                              , STAT= sbc_ice_alloc ) 
    8080         ! 
    8181      IF( lk_mpp            )   CALL mpp_sum ( sbc_ice_alloc ) 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90

    r2620 r2690  
    103103         &      vtau(jpi,jpj) , vtau_b(jpi,jpj) , wndm(jpi,jpj) , STAT=ierr(1) )  
    104104         ! 
    105       ALLOCATE( qns_tot(jpi,jpj) , qns   (jpi,jpj) , qns_b(jpi,jpj),      & 
    106          &      qsr_tot(jpi,jpj) , qsr   (jpi,jpj) ,                     & 
    107          &      emp    (jpi,jpj) , emp_b (jpi,jpj) ,                       & 
    108          &      emps   (jpi,jpj) , emps_b(jpi,jpj) , emp_tot(jpi,jpj) , STAT=ierr(2)) 
     105      ALLOCATE( qns_tot(jpi,jpj) , qns   (jpi,jpj) , qns_b(jpi,jpj),        & 
     106         &      qsr_tot(jpi,jpj) , qsr   (jpi,jpj) ,                        & 
     107         &      emp    (jpi,jpj) , emp_b (jpi,jpj) ,                        & 
     108         &      emps   (jpi,jpj) , emps_b(jpi,jpj) , emp_tot(jpi,jpj) , STAT=ierr(2) ) 
    109109         ! 
    110110      ALLOCATE( rnf  (jpi,jpj) , sbc_tsc  (jpi,jpj,jpts) , qsr_hc  (jpi,jpj,jpk) ,     & 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC/sbcana.F90

    r2620 r2690  
    2727   PUBLIC   sbc_gyre   ! routine called in sbcmod module 
    2828 
    29    !                               !!* Namelist namsbc_ana * 
    30    INTEGER  ::   nn_tau000 = 1      ! nb of time-step during which the surface stress 
    31    !                                ! increase from 0 to its nominal value  
    32    REAL(wp) ::   rn_utau0  = 0.e0   ! constant wind stress value in i-direction 
    33    REAL(wp) ::   rn_vtau0  = 0.e0   ! constant wind stress value in j-direction 
    34    REAL(wp) ::   rn_qns0   = 0.e0   ! non solar heat flux 
    35    REAL(wp) ::   rn_qsr0   = 0.e0   !     solar heat flux 
    36    REAL(wp) ::   rn_emp0   = 0.e0   ! net freshwater flux 
     29   !                                !!* Namelist namsbc_ana * 
     30   INTEGER  ::   nn_tau000 = 1       ! nb of time-step during which the surface stress 
     31   !                                 ! increase from 0 to its nominal value  
     32   REAL(wp) ::   rn_utau0  = 0._wp   ! constant wind stress value in i-direction 
     33   REAL(wp) ::   rn_vtau0  = 0._wp   ! constant wind stress value in j-direction 
     34   REAL(wp) ::   rn_qns0   = 0._wp   ! non solar heat flux 
     35   REAL(wp) ::   rn_qsr0   = 0._wp   !     solar heat flux 
     36   REAL(wp) ::   rn_emp0   = 0._wp   ! net freshwater flux 
    3737    
    3