New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 4201 for branches/2013/dev_CMCC_INGV_2013/NEMOGCM/NEMO/OPA_SRC – NEMO

Ignore:
Timestamp:
2013-11-14T15:09:37+01:00 (11 years ago)
Author:
poddo
Message:

ticket #1178 Merge of CMCC-INGV 2013 branches

Location:
branches/2013/dev_CMCC_INGV_2013/NEMOGCM/NEMO/OPA_SRC
Files:
21 edited

Legend:

Unmodified
Added
Removed

  • branches/2013/dev_CMCC_INGV_2013/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90

    r3909 r4201  
    448448            ln_full_vel = .false. 
    449449            ! ... default values (NB: frequency positive => hours, negative => months) 
    450             !                    !  file       ! frequency !  variable   ! time intep !  clim   ! 'yearly' or ! weights  ! rotation  ! 
    451             !                    !  name       ! hours !   name     !  (T/F)  !  (T/F)  !  'monthly'  ! filename ! pairs     ! 
    452             bn_ssh     = FLD_N(  'bdy_ssh'     ,  24   , 'sossheig' , .false. , .false. ,   'yearly'  , ''       , ''        ) 
    453             bn_u2d     = FLD_N(  'bdy_vel2d_u' ,  24   , 'vobtcrtx' , .false. , .false. ,   'yearly'  , ''       , ''        ) 
    454             bn_v2d     = FLD_N(  'bdy_vel2d_v' ,  24   , 'vobtcrty' , .false. , .false. ,   'yearly'  , ''       , ''        ) 
    455             bn_u3d     = FLD_N(  'bdy_vel3d_u' ,  24   , 'vozocrtx' , .false. , .false. ,   'yearly'  , ''       , ''        ) 
    456             bn_v3d     = FLD_N(  'bdy_vel3d_v' ,  24   , 'vomecrty' , .false. , .false. ,   'yearly'  , ''       , ''        ) 
    457             bn_tem     = FLD_N(  'bdy_tem'     ,  24   , 'votemper' , .false. , .false. ,   'yearly'  , ''       , ''        ) 
    458             bn_sal     = FLD_N(  'bdy_sal'     ,  24   , 'vosaline' , .false. , .false. ,   'yearly'  , ''       , ''        ) 
    459 #if defined key_lim2 
    460             bn_frld    = FLD_N(  'bdy_frld'    ,  24   , 'ildsconc' , .false. , .false. ,   'yearly'  , ''       , ''        ) 
    461             bn_hicif   = FLD_N(  'bdy_hicif'   ,  24   , 'iicethic' , .false. , .false. ,   'yearly'  , ''       , ''        ) 
    462             bn_hsnif   = FLD_N(  'bdy_hsnif'   ,  24   , 'isnothic' , .false. , .false. ,   'yearly'  , ''       , ''        ) 
     450            !                    !  file       ! frequency !  variable   ! time intep !  clim   ! 'yearly' or ! weights  ! rotation  ! land/sea mask !  
     451            !                    !  name       ! hours     !   name      !  (T/F)     !  (T/F)  !  'monthly'  ! filename ! pairs     ! filename      ! 
     452            bn_ssh     = FLD_N(  'bdy_ssh'     ,  24       , 'sossheig'  , .false.    , .false. ,   'yearly'  , ''       , ''        , ''            ) 
     453            bn_u2d     = FLD_N(  'bdy_vel2d_u' ,  24       , 'vobtcrtx'  , .false.    , .false. ,   'yearly'  , ''       , ''        , ''            ) 
     454            bn_v2d     = FLD_N(  'bdy_vel2d_v' ,  24       , 'vobtcrty'  , .false.    , .false. ,   'yearly'  , ''       , ''        , ''            ) 
     455            bn_u3d     = FLD_N(  'bdy_vel3d_u' ,  24       , 'vozocrtx'  , .false.    , .false. ,   'yearly'  , ''       , ''        , ''            ) 
     456            bn_v3d     = FLD_N(  'bdy_vel3d_v' ,  24       , 'vomecrty'  , .false.    , .false. ,   'yearly'  , ''       , ''        , ''            ) 
     457            bn_tem     = FLD_N(  'bdy_tem'     ,  24       , 'votemper'  , .false.    , .false. ,   'yearly'  , ''       , ''        , ''            ) 
     458            bn_sal     = FLD_N(  'bdy_sal'     ,  24       , 'vosaline'  , .false.    , .false. ,   'yearly'  , ''       , ''        , ''            ) 
     459#if defined key_lim2 
     460            bn_frld    = FLD_N(  'bdy_frld'    ,  24       , 'ildsconc'  , .false.    , .false. ,   'yearly'  , ''       , ''        , ''            ) 
     461            bn_hicif   = FLD_N(  'bdy_hicif'   ,  24       , 'iicethic'  , .false.    , .false. ,   'yearly'  , ''       , ''        , ''            ) 
     462            bn_hsnif   = FLD_N(  'bdy_hsnif'   ,  24       , 'isnothic'  , .false.    , .false. ,   'yearly'  , ''       , ''        , ''            ) 
    463463#endif 
    464464 

  • branches/2013/dev_CMCC_INGV_2013/NEMOGCM/NEMO/OPA_SRC/DOM/dtatsd.F90

    r3294 r4201  
    7272      cn_dir = './'                       ! directory in which the model is executed 
    7373      !                                   ! sn_... default values (NB: frequency positive => hours, negative => months) 
    74       !            !   file    ! frequency ! variable  ! time intep !  clim   ! 'yearly' or ! weights  ! rotation ! 
    75       !            !   name    !  (hours)  !  name     !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs    ! 
    76       sn_tem = FLD_N( 'temperature',  -1.  , 'votemper',  .false.   , .true.  ,  'monthly'  , ''       , ''       ) 
    77       sn_sal = FLD_N( 'salinity'   ,  -1.  , 'vosaline',  .false.   , .true.  ,  'monthly'  , ''       , ''       ) 
     74      !            !   file    ! frequency ! variable  ! time intep !  clim   ! 'yearly' or ! weights  ! rotation ! land/sea mask ! 
     75      !            !   name    !  (hours)  !  name     !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs    ! filename      ! 
     76      sn_tem = FLD_N( 'temperature',  -1.  , 'votemper',  .false.   , .true.  ,  'monthly'  , ''       , ''       , ''            ) 
     77      sn_sal = FLD_N( 'salinity'   ,  -1.  , 'vosaline',  .false.   , .true.  ,  'monthly'  , ''       , ''       , ''            ) 
    7878 
    7979      REWIND( numnam )              ! read in namlist namdta_tsd  

  • branches/2013/dev_CMCC_INGV_2013/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90

    r3294 r4201  
    55   !!====================================================================== 
    66   !! History :  3.2  ! 2009-03  (R. Benshila)  Original code  
     7   !!            3.5  ! 2013-07 (I. Epicoco, S. Mocavero - CMCC) MPP optimization  
    78   !!---------------------------------------------------------------------- 
    89 
    … …  
    1112   !!   lbc_nfd_3d    : lateral boundary condition: North fold treatment for a 3D arrays   (lbc_nfd) 
    1213   !!   lbc_nfd_2d    : lateral boundary condition: North fold treatment for a 2D arrays   (lbc_nfd) 
     14   !!   mpp_lbc_nfd_3d    : North fold treatment for a 3D arrays optimized for MPP 
     15   !!   mpp_lbc_nfd_2d    : North fold treatment for a 2D arrays optimized for MPP 
    1316   !!---------------------------------------------------------------------- 
    1417   USE dom_oce        ! ocean space and time domain  
    … …  
    2326 
    2427   PUBLIC   lbc_nfd   ! north fold conditions 
     28   INTERFACE mpp_lbc_nfd 
     29      MODULE PROCEDURE   mpp_lbc_nfd_3d, mpp_lbc_nfd_2d 
     30   END INTERFACE 
     31 
     32   PUBLIC   mpp_lbc_nfd   ! north fold conditions in parallel case 
     33 
     34   INTEGER, PUBLIC,  PARAMETER :: jpmaxngh = 3 
     35   INTEGER, PUBLIC                                  ::   nsndto 
     36   INTEGER, PUBLIC,  DIMENSION (jpmaxngh)           ::   isendto ! processes to which communicate 
     37 
     38 
    2539 
    2640   !!---------------------------------------------------------------------- 
    … …  
    342356   END SUBROUTINE lbc_nfd_2d 
    343357 
    344    !!====================================================================== 
     358 
     359   SUBROUTINE mpp_lbc_nfd_3d( pt3dl, pt3dr, cd_type, psgn ) 
     360      !!---------------------------------------------------------------------- 
     361      !!                  ***  routine mpp_lbc_nfd_3d  *** 
     362      !! 
     363      !! ** Purpose :   3D lateral boundary condition : North fold treatment 
     364      !!              without processor exchanges.  
     365      !! 
     366      !! ** Method  :    
     367      !! 
     368      !! ** Action  :   pt3d with updated values along the north fold 
     369      !!---------------------------------------------------------------------- 
     370      CHARACTER(len=1)          , INTENT(in   ) ::   cd_type   ! define the nature of ptab array grid-points 
     371      !                                                        !   = T , U , V , F , W points 
     372      REAL(wp)                  , INTENT(in   ) ::   psgn      ! control of the sign change 
     373      !                                                        !   = -1. , the sign is changed if north fold boundary 
     374      !                                                        !   =  1. , the sign is kept  if north fold boundary 
     375      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pt3dl      ! 3D array on which the boundary condition is applied 
     376      REAL(wp), DIMENSION(:,:,:), INTENT(in) ::   pt3dr      ! 3D array on which the boundary condition is applied 
     377      ! 
     378      INTEGER  ::   ji, jk 
     379      INTEGER  ::   ijt, iju, ijpj, ijpjm1, ijta, ijua, jia, startloop, endloop 
     380      !!---------------------------------------------------------------------- 
     381 
     382      SELECT CASE ( jpni ) 
     383      CASE ( 1 )     ;   ijpj = nlcj      ! 1 proc only  along the i-direction 
     384      CASE DEFAULT   ;   ijpj = 4         ! several proc along the i-direction 
     385      END SELECT 
     386      ijpjm1 = ijpj-1 
     387 
     388         ! 
     389         SELECT CASE ( npolj ) 
     390         ! 
     391         CASE ( 3 , 4 )                        ! *  North fold  T-point pivot 
     392            ! 
     393            SELECT CASE ( cd_type ) 
     394            CASE ( 'T' , 'W' )                         ! T-, W-point 
     395               IF (narea .ne. (jpnij - jpni + 1)) THEN 
     396                 startloop = 1 
     397               ELSE 
     398                 startloop = 2 
     399               ENDIF 
     400 
     401               DO jk = 1, jpk 
     402                  DO ji = startloop, nlci 
     403                     ijt = jpiglo - ji - nimpp - nimppt(isendto(1)) + 4 
     404                     pt3dl(ji,ijpj,jk) = psgn * pt3dr(ijt,ijpj-2,jk) 
     405                  END DO 
     406               END DO 
     407 
     408               IF(nimpp .ge. (jpiglo/2+1)) THEN 
     409                 startloop = 1 
     410               ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN 
     411                 startloop = jpiglo/2+1 - nimpp + 1 
     412               ELSE 
     413                 startloop = nlci + 1 
     414               ENDIF 
     415               IF(startloop .le. nlci) THEN 
     416                 DO jk = 1, jpk 
     417                    DO ji = startloop, nlci 
     418                       ijt = jpiglo - ji - nimpp - nimppt(isendto(1)) + 4 
     419                       jia = ji + nimpp - 1 
     420                       ijta = jpiglo - jia + 2 
     421                       IF((ijta .ge. (startloop + nimpp - 1)) .and. (ijta .lt. jia)) THEN 
     422                          pt3dl(ji,ijpjm1,jk) = psgn * pt3dl(ijta-nimpp+1,ijpjm1,jk) 
     423                       ELSE 
     424                          pt3dl(ji,ijpjm1,jk) = psgn * pt3dr(ijt,ijpjm1,jk) 
     425                       ENDIF 
     426                    END DO 
     427                 END DO 
     428               ENDIF 
     429 
     430 
     431 
     432            CASE ( 'U' )                               ! U-point 
     433               IF (narea .ne. (jpnij)) THEN 
     434                  endloop = nlci 
     435               ELSE 
     436                  endloop = nlci - 1 
     437               ENDIF 
     438               DO jk = 1, jpk 
     439                  DO ji = 1, endloop 
     440                     iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 3 
     441                     pt3dl(ji,ijpj,jk) = psgn * pt3dr(iju,ijpj-2,jk) 
     442                  END DO 
     443               END DO 
     444 
     445               IF (narea .ne. (jpnij)) THEN 
     446                  endloop = nlci 
     447               ELSE 
     448                  endloop = nlci - 1 
     449               ENDIF 
     450               IF(nimpp .ge. (jpiglo/2)) THEN 
     451                  startloop = 1 
     452               ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2)) .AND. (nimpp .lt. (jpiglo/2))) THEN 
     453                  startloop = jpiglo/2 - nimpp + 1 
     454               ELSE 
     455                  startloop = endloop + 1 
     456               ENDIF 
     457               IF (startloop .le. endloop) THEN 
     458                 DO jk = 1, jpk 
     459                    DO ji = startloop, endloop 
     460                      iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 3 
     461                      jia = ji + nimpp - 1 
     462                      ijua = jpiglo - jia + 1 
     463                      IF((ijua .ge. (startloop + nimpp - 1)) .and. (ijua .lt. jia)) THEN 
     464                        pt3dl(ji,ijpjm1,jk) = psgn * pt3dl(ijua-nimpp+1,ijpjm1,jk) 
     465                      ELSE 
     466                        pt3dl(ji,ijpjm1,jk) = psgn * pt3dr(iju,ijpjm1,jk) 
     467                      ENDIF 
     468                    END DO 
     469                 END DO 
     470               ENDIF 
     471 
     472            CASE ( 'V' )                               ! V-point 
     473               IF (narea .ne. (jpnij - jpni + 1)) THEN 
     474                  startloop = 1 
     475               ELSE 
     476                  startloop = 2 
     477               ENDIF 
     478               DO jk = 1, jpk 
     479                  DO ji = startloop, nlci 
     480                     ijt = jpiglo - ji - nimpp - nimppt(isendto(1)) + 4 
     481                     pt3dl(ji,ijpj-1,jk) = psgn * pt3dr(ijt,ijpj-2,jk) 
     482                     pt3dl(ji,ijpj  ,jk) = psgn * pt3dr(ijt,ijpj-3,jk) 
     483                  END DO 
     484               END DO 
     485            CASE ( 'F' )                               ! F-point 
     486               IF (narea .ne. (jpnij)) THEN 
     487                  endloop = nlci 
     488               ELSE 
     489                  endloop = nlci - 1 
     490               ENDIF 
     491               DO jk = 1, jpk 
     492                  DO ji = 1, endloop 
     493                     iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 3 
     494                     pt3dl(ji,ijpj-1,jk) = psgn * pt3dr(iju,ijpj-2,jk) 
     495                     pt3dl(ji,ijpj  ,jk) = psgn * pt3dr(iju,ijpj-3,jk) 
     496                  END DO 
     497               END DO 
     498            END SELECT 
     499            ! 
     500 
     501         CASE ( 5 , 6 )                        ! *  North fold  F-point pivot 
     502            ! 
     503            SELECT CASE ( cd_type ) 
     504            CASE ( 'T' , 'W' )                         ! T-, W-point 
     505               DO jk = 1, jpk 
     506                  DO ji = 1, nlci 
     507                     ijt = jpiglo - ji - nimpp - nimppt(isendto(1)) + 3 
     508                     pt3dl(ji,ijpj,jk) = psgn * pt3dr(ijt,ijpj-1,jk) 
     509                  END DO 
     510               END DO 
     511 
     512            CASE ( 'U' )                               ! U-point 
     513               IF (narea .ne. (jpnij)) THEN 
     514                  endloop = nlci 
     515               ELSE 
     516                  endloop = nlci - 1 
     517               ENDIF 
     518               DO jk = 1, jpk 
     519                  DO ji = 1, endloop 
     520                     iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 2 
     521                     pt3dl(ji,ijpj,jk) = psgn * pt3dr(iju,ijpj-1,jk) 
     522                  END DO 
     523               END DO 
     524 
     525            CASE ( 'V' )                               ! V-point 
     526               DO jk = 1, jpk 
     527                  DO ji = 1, nlci 
     528                     ijt = jpiglo - ji- nimpp - nimppt(isendto(1)) + 3 
     529                     pt3dl(ji,ijpj,jk) = psgn * pt3dr(ijt,ijpj-2,jk) 
     530                  END DO 
     531               END DO 
     532 
     533               IF(nimpp .ge. (jpiglo/2+1)) THEN 
     534                  startloop = 1 
     535               ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN 
     536                  startloop = jpiglo/2+1 - nimpp + 1 
     537               ELSE 
     538                  startloop = nlci + 1 
     539               ENDIF 
     540               IF(startloop .le. nlci) THEN 
     541                 DO jk = 1, jpk 
     542                    DO ji = startloop, nlci 
     543                       ijt = jpiglo - ji - nimpp - nimppt(isendto(1)) + 3 
     544                       pt3dl(ji,ijpjm1,jk) = psgn * pt3dr(ijt,ijpjm1,jk) 
     545                    END DO 
     546                 END DO 
     547               ENDIF 
     548 
     549            CASE ( 'F' )                               ! F-point 
     550               IF (narea .ne. (jpnij)) THEN 
     551                  endloop = nlci 
     552               ELSE 
     553                  endloop = nlci - 1 
     554               ENDIF 
     555               DO jk = 1, jpk 
     556                  DO ji = 1, endloop 
     557                     iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 2 
     558                     pt3dl(ji,ijpj ,jk) = psgn * pt3dr(iju,ijpj-2,jk) 
     559                  END DO 
     560               END DO 
     561 
     562               IF (narea .ne. (jpnij)) THEN 
     563                  endloop = nlci 
     564               ELSE 
     565                  endloop = nlci - 1 
     566               ENDIF 
     567               IF(nimpp .ge. (jpiglo/2+1)) THEN 
     568                  startloop = 1 
     569               ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN 
     570                  startloop = jpiglo/2+1 - nimpp + 1 
     571               ELSE 
     572                  startloop = endloop + 1 
     573               ENDIF 
     574               IF (startloop .le. endloop) THEN 
     575                  DO jk = 1, jpk 
     576                     DO ji = startloop, endloop 
     577                        iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 2 
     578                        pt3dl(ji,ijpjm1,jk) = psgn * pt3dr(iju,ijpjm1,jk) 
     579                     END DO 
     580                  END DO 
     581               ENDIF 
     582 
     583            END SELECT 
     584 
     585         CASE DEFAULT                           ! *  closed : the code probably never go through 
     586            ! 
     587            SELECT CASE ( cd_type) 
     588            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points 
     589               pt3dl(:, 1  ,jk) = 0.e0 
     590               pt3dl(:,ijpj,jk) = 0.e0 
     591            CASE ( 'F' )                               ! F-point 
     592               pt3dl(:,ijpj,jk) = 0.e0 
     593            END SELECT 
     594            ! 
     595         END SELECT     !  npolj 
     596         ! 
     597      ! 
     598   END SUBROUTINE mpp_lbc_nfd_3d 
     599 
     600 
     601   SUBROUTINE mpp_lbc_nfd_2d( pt2dl, pt2dr, cd_type, psgn ) 
     602      !!---------------------------------------------------------------------- 
     603      !!                  ***  routine mpp_lbc_nfd_2d  *** 
     604      !! 
     605      !! ** Purpose :   2D lateral boundary condition : North fold treatment 
     606      !!       without processor exchanges.  
     607      !! 
     608      !! ** Method  :    
     609      !! 
     610      !! ** Action  :   pt2d with updated values along the north fold 
     611      !!---------------------------------------------------------------------- 
     612      CHARACTER(len=1)        , INTENT(in   ) ::   cd_type   ! define the nature of ptab array grid-points 
     613      !                                                      ! = T , U , V , F , W points 
     614      REAL(wp)                , INTENT(in   ) ::   psgn      ! control of the sign change 
     615      !                                                      !   = -1. , the sign is changed if north fold boundary 
     616      !                                                      !   =  1. , the sign is kept  if north fold boundary 
     617      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pt2dl      ! 2D array on which the boundary condition is applied 
     618      REAL(wp), DIMENSION(:,:), INTENT(in) ::   pt2dr      ! 2D array on which the boundary condition is applied 
     619      ! 
     620      INTEGER  ::   ji 
     621      INTEGER  ::   ijt, iju, ijpj, ijpjm1, ijta, ijua, jia, startloop, endloop 
     622      !!---------------------------------------------------------------------- 
     623 
     624      SELECT CASE ( jpni ) 
     625      CASE ( 1 )     ;   ijpj = nlcj      ! 1 proc only  along the i-direction 
     626      CASE DEFAULT   ;   ijpj = 4         ! several proc along the i-direction 
     627      END SELECT 
     628      ! 
     629      ijpjm1 = ijpj-1 
     630 
     631 
     632      SELECT CASE ( npolj ) 
     633      ! 
     634      CASE ( 3, 4 )                       ! *  North fold  T-point pivot 
     635         ! 
     636         SELECT CASE ( cd_type ) 
     637         ! 
     638         CASE ( 'T' , 'W' )                               ! T- , W-points 
     639            IF (narea .ne. (jpnij - jpni + 1)) THEN 
     640              startloop = 1 
     641            ELSE 
     642              startloop = 2 
     643            ENDIF 
     644            DO ji = startloop, nlci 
     645              ijt=jpiglo - ji - nimpp - nimppt(isendto(1)) + 4 
     646              pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1-1) 
     647            END DO 
     648 
     649            IF(nimpp .ge. (jpiglo/2+1)) THEN 
     650               startloop = 1 
     651            ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN 
     652               startloop = jpiglo/2+1 - nimpp + 1 
     653            ELSE 
     654               startloop = nlci + 1 
     655            ENDIF 
     656            DO ji = startloop, nlci 
     657               ijt=jpiglo - ji - nimpp - nimppt(isendto(1)) + 4 
     658               jia = ji + nimpp - 1 
     659               ijta = jpiglo - jia + 2 
     660               IF((ijta .ge. (startloop + nimpp - 1)) .and. (ijta .lt. jia)) THEN 
     661                  pt2dl(ji,ijpjm1) = psgn * pt2dl(ijta-nimpp+1,ijpjm1) 
     662               ELSE 
     663                  pt2dl(ji,ijpjm1) = psgn * pt2dr(ijt,ijpjm1) 
     664               ENDIF 
     665            END DO 
     666 
     667         CASE ( 'U' )                                     ! U-point 
     668            IF (narea .ne. (jpnij)) THEN 
     669               endloop = nlci 
     670            ELSE 
     671               endloop = nlci - 1 
     672            ENDIF 
     673            DO ji = 1, endloop 
     674               iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 3 
     675               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1-1) 
     676            END DO 
     677 
     678            IF (narea .ne. (jpnij)) THEN 
     679               endloop = nlci 
     680            ELSE 
     681               endloop = nlci - 1 
     682            ENDIF 
     683            IF(nimpp .ge. (jpiglo/2)) THEN 
     684               startloop = 1 
     685            ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2)) .AND. (nimpp .lt. (jpiglo/2))) THEN 
     686               startloop = jpiglo/2 - nimpp + 1 
     687            ELSE 
     688               startloop = endloop + 1 
     689            ENDIF 
     690            DO ji = startloop, endloop 
     691               iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 3 
     692               jia = ji + nimpp - 1 
     693               ijua = jpiglo - jia + 1 
     694               IF((ijua .ge. (startloop + nimpp - 1)) .and. (ijua .lt. jia)) THEN 
     695                  pt2dl(ji,ijpjm1) = psgn * pt2dl(ijua-nimpp+1,ijpjm1) 
     696               ELSE 
     697                  pt2dl(ji,ijpjm1) = psgn * pt2dr(iju,ijpjm1) 
     698               ENDIF 
     699            END DO 
     700 
     701         CASE ( 'V' )                                     ! V-point 
     702            IF (narea .ne. (jpnij - jpni + 1)) THEN 
     703              startloop = 1 
     704            ELSE 
     705              startloop = 2 
     706            ENDIF 
     707            DO ji = startloop, nlci 
     708              ijt=jpiglo - ji - nimpp - nimppt(isendto(1)) + 4 
     709              pt2dl(ji,ijpjm1) = psgn * pt2dr(ijt,ijpjm1-1) 
     710              pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1-2) 
     711            END DO 
     712 
     713         CASE ( 'F' )                                     ! F-point 
     714            IF (narea .ne. (jpnij)) THEN 
     715               endloop = nlci 
     716            ELSE 
     717               endloop = nlci - 1 
     718            ENDIF 
     719            DO ji = 1, endloop 
     720               iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 3 
     721               pt2dl(ji,ijpjm1) = psgn * pt2dr(iju,ijpjm1-1) 
     722               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1-2) 
     723            END DO 
     724 
     725         CASE ( 'I' )                                     ! ice U-V point (I-point) 
     726            IF (narea .ne. (jpnij - jpni + 1)) THEN 
     727               startloop = 1 
     728            ELSE 
     729               startloop = 3 
     730               pt2dl(2,ijpj) = psgn * pt2dr(3,ijpjm1) 
     731            ENDIF 
     732            DO ji = startloop, nlci 
     733               iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 5 
     734               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1) 
     735            END DO 
     736 
     737         CASE ( 'J' )                                     ! first ice U-V point 
     738            IF (narea .ne. (jpnij - jpni + 1)) THEN 
     739               startloop = 1 
     740            ELSE 
     741               startloop = 3 
     742               pt2dl(2,ijpj) = psgn * pt2dr(3,ijpjm1) 
     743            ENDIF 
     744            DO ji = startloop, nlci 
     745               iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 5 
     746               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1) 
     747            END DO 
     748 
     749         CASE ( 'K' )                                     ! second ice U-V point 
     750            IF (narea .ne. (jpnij - jpni + 1)) THEN 
     751               startloop = 1 
     752            ELSE 
     753               startloop = 3 
     754               pt2dl(2,ijpj) = psgn * pt2dr(3,ijpjm1) 
     755            ENDIF 
     756            DO ji = startloop, nlci 
     757               iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 5 
     758               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1) 
     759            END DO 
     760 
     761         END SELECT 
     762         ! 
     763      CASE ( 5, 6 )                        ! *  North fold  F-point pivot 
     764         ! 
     765         SELECT CASE ( cd_type ) 
     766         CASE ( 'T' , 'W' )                               ! T-, W-point 
     767            DO ji = 1, nlci 
     768               ijt = jpiglo - ji - nimpp - nimppt(isendto(1)) + 3 
     769               pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1) 
     770            END DO 
     771 
     772         CASE ( 'U' )                                     ! U-point 
     773            IF (narea .ne. (jpnij)) THEN 
     774               endloop = nlci 
     775            ELSE 
     776               endloop = nlci - 1 
     777            ENDIF 
     778            DO ji = 1, endloop 
     779               iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 2 
     780               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1) 
     781            END DO 
     782 
     783         CASE ( 'V' )                                     ! V-point 
     784            DO ji = 1, nlci 
     785               ijt = jpiglo - ji - nimpp - nimppt(isendto(1)) + 3 
     786               pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1-1) 
     787            END DO 
     788            IF(nimpp .ge. (jpiglo/2+1)) THEN 
     789               startloop = 1 
     790            ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN 
     791               startloop = jpiglo/2+1 - nimpp + 1 
     792            ELSE 
     793               startloop = nlci + 1 
     794            ENDIF 
     795            DO ji = startloop, nlci 
     796               ijt = jpiglo - ji - nimpp - nimppt(isendto(1)) + 3 
     797               pt2dl(ji,ijpjm1) = psgn * pt2dr(ijt,ijpjm1) 
     798            END DO 
     799 
     800         CASE ( 'F' )                               ! F-point 
     801            IF (narea .ne. (jpnij)) THEN 
     802               endloop = nlci 
     803            ELSE 
     804               endloop = nlci - 1 
     805            ENDIF 
     806            DO ji = 1, endloop 
     807               iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 2 
     808               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1-1) 
     809            END DO 
     810 
     811            IF (narea .ne. (jpnij)) THEN 
     812               endloop = nlci 
     813            ELSE 
     814               endloop = nlci - 1 
     815            ENDIF 
     816            IF(nimpp .ge. (jpiglo/2+1)) THEN 
     817               startloop = 1 
     818            ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN 
     819               startloop = jpiglo/2+1 - nimpp + 1 
     820            ELSE 
     821               startloop = endloop + 1 
     822            ENDIF 
     823 
     824            DO ji = startloop, endloop 
     825               iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 2 
     826               pt2dl(ji,ijpjm1) = psgn * pt2dr(iju,ijpjm1) 
     827            END DO 
     828 
     829         CASE ( 'I' )                                  ! ice U-V point (I-point) 
     830               IF (narea .ne. (jpnij - jpni + 1)) THEN 
     831                  startloop = 1 
     832               ELSE 
     833                  startloop = 2 
     834               ENDIF 
     835               IF (narea .ne. jpnij) THEN 
     836                  endloop = nlci 
     837               ELSE 
     838                  endloop = nlci - 1 
     839               ENDIF 
     840               DO ji = startloop , endloop 
     841                  ijt = jpiglo - ji - nimpp - nimppt(isendto(1)) + 4 
     842                  pt2dl(ji,ijpj)= 0.5 * (pt2dr(ji,ijpjm1) + psgn * pt2dr(ijt,ijpjm1)) 
     843               END DO 
     844 
     845         CASE ( 'J' )                                  ! first ice U-V point 
     846               IF (narea .ne. (jpnij - jpni + 1)) THEN 
     847                  startloop = 1 
     848               ELSE 
     849                  startloop = 2 
     850               ENDIF 
     851               IF (narea .ne. jpnij) THEN 
     852                  endloop = nlci 
     853               ELSE 
     854                  endloop = nlci - 1 
     855               ENDIF 
     856               DO ji = startloop , endloop 
     857                  ijt = jpiglo - ji - nimpp - nimppt(isendto(1)) + 4 
     858                  pt2dl(ji,ijpj) = pt2dr(ji,ijpjm1) 
     859               END DO 
     860 
     861         CASE ( 'K' )                                  ! second ice U-V point 
     862               IF (narea .ne. (jpnij - jpni + 1)) THEN 
     863                  startloop = 1 
     864               ELSE 
     865                  startloop = 2 
     866               ENDIF 
     867               IF (narea .ne. jpnij) THEN 
     868                  endloop = nlci 
     869               ELSE 
     870                  endloop = nlci - 1 
     871               ENDIF 
     872               DO ji = startloop, endloop 
     873                  ijt = jpiglo - ji - nimpp - nimppt(isendto(1)) + 4 
     874                  pt2dl(ji,ijpj) = pt2dr(ijt,ijpjm1) 
     875               END DO 
     876 
     877         END SELECT 
     878         ! 
     879      CASE DEFAULT                           ! *  closed : the code probably never go through 
     880         ! 
     881         SELECT CASE ( cd_type) 
     882         CASE ( 'T' , 'U' , 'V' , 'W' )                 ! T-, U-, V-, W-points 
     883            pt2dl(:, 1     ) = 0.e0 
     884            pt2dl(:,ijpj) = 0.e0 
     885         CASE ( 'F' )                                   ! F-point 
     886            pt2dl(:,ijpj) = 0.e0 
     887         CASE ( 'I' )                                   ! ice U-V point 
     888            pt2dl(:, 1     ) = 0.e0 
     889            pt2dl(:,ijpj) = 0.e0 
     890         CASE ( 'J' )                                   ! first ice U-V point 
     891            pt2dl(:, 1     ) = 0.e0 
     892            pt2dl(:,ijpj) = 0.e0 
     893         CASE ( 'K' )                                   ! second ice U-V point 
     894            pt2dl(:, 1     ) = 0.e0 
     895            pt2dl(:,ijpj) = 0.e0 
     896         END SELECT 
     897         ! 
     898      END SELECT 
     899      ! 
     900   END SUBROUTINE mpp_lbc_nfd_2d 
     901 
    345902END MODULE lbcnfd 

  • branches/2013/dev_CMCC_INGV_2013/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90

    r4047 r4201  
    2222   !!                          'mpp_lnk_bdy_2d' and 'mpp_lnk_obc_2d' routines and update 
    2323   !!                          the mppobc routine to optimize the BDY and OBC communications 
     24   !!            3.5  !  2013 (S.Mocavero, I.Epicoco - CMCC) north fold optimizations 
    2425   !!---------------------------------------------------------------------- 
    2526 
    … …  
    165166   REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, SAVE   ::   xnorthgloio 
    166167   REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE, SAVE   ::   foldwk      ! Workspace for message transfers avoiding mpi_allgather 
     168   REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE, SAVE   ::   ztabl_3d 
     169   REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE, SAVE   ::   ztabr_3d 
    167170 
    168171   ! Arrays used in mpp_lbc_north_2d() 
    … …  
    170173   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE    ::   xnorthgloio_2d 
    171174   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, SAVE    ::   foldwk_2d    ! Workspace for message transfers avoiding mpi_allgather 
     175   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, SAVE   ::   ztabl_2d 
     176   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, SAVE   ::   ztabr_2d 
    172177 
    173178   ! Arrays used in mpp_lbc_north_e() 
    … …  
    175180   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE    ::   xnorthgloio_e 
    176181 
    177    ! North fold arrays used to minimise the use of allgather operations. Set in nemo_northcomms (nemogcm) so need to be public 
    178    INTEGER, PUBLIC,  PARAMETER :: jpmaxngh = 8                 ! Assumed maximum number of active neighbours 
    179    INTEGER, PUBLIC,  PARAMETER :: jptyps   = 5                 ! Number of different neighbour lists to be used for northfold exchanges 
    180    INTEGER, PUBLIC,  DIMENSION (jpmaxngh,jptyps)    ::   isendto 
    181    INTEGER, PUBLIC,  DIMENSION (jptyps)             ::   nsndto 
    182182   LOGICAL, PUBLIC                                  ::   ln_nnogather     = .FALSE.  ! namelist control of northfold comms 
    183183   LOGICAL, PUBLIC                                  ::   l_north_nogather = .FALSE.  ! internal control of northfold comms 
    … …  
    214214         ! 
    215215         &      tab_e(jpiglo,4+2*jpr2dj) , xnorthloc_e(jpi,4+2*jpr2dj) , xnorthgloio_e(jpi,4+2*jpr2dj,jpni) ,   & 
     216         ! 
     217         &      ztabl_3d(jpi,4,jpk), ztabr_3d(jpi*jpmaxngh, 4, jpk), ztabl_2d(jpi,4), ztabr_2d(jpi*jpmaxngh, 4), & 
    216218         ! 
    217219         &      STAT=lib_mpp_alloc ) 
    … …  
    25852587      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points 
    25862588      !                                                              !   = T ,  U , V , F or W  gridpoints 
    2587       REAL(wp)                        , INTENT(in   ) ::   psgn      ! = -1. the sign change across the north fold 
     2589      REAL(wp)                        , INTENT(in   ) ::   psgn      ! = -1. the sign change across the north fold  
    25882590      !!                                                             ! =  1. , the sign is kept 
    2589       INTEGER ::   ji, jj, jr 
     2591      INTEGER ::   ji, jj, jr, jk 
    25902592      INTEGER ::   ierr, itaille, ildi, ilei, iilb 
    25912593      INTEGER ::   ijpj, ijpjm1, ij, iproc 
    2592       INTEGER, DIMENSION (jpmaxngh)          ::   ml_req_nf          ! for mpi_isend when avoiding mpi_allgather 
     2594      INTEGER, DIMENSION (jpmaxngh)           ::   ml_req_nf          !for mpi_isend when avoiding mpi_allgather 
    25932595      INTEGER                                ::   ml_err             ! for mpi_isend when avoiding mpi_allgather 
    25942596      INTEGER, DIMENSION(MPI_STATUS_SIZE)    ::   ml_stat            ! for mpi_isend when avoiding mpi_allgather 
    2595       !!---------------------------------------------------------------------- 
    2596       ! 
     2597      INTEGER :: istatus(mpi_status_size) 
     2598      INTEGER :: iflag 
     2599      !!---------------------------------------------------------------------- 
     2600      ! 
     2601 
    25972602      ijpj   = 4 
    2598       ityp = -1 
    25992603      ijpjm1 = 3 
    2600       tab_3d(:,:,:) = 0.e0 
    2601       ! 
    2602       DO jj = nlcj - ijpj +1, nlcj          ! put in xnorthloc the last 4 jlines of pt3d 
    2603          ij = jj - nlcj + ijpj 
    2604          xnorthloc(:,ij,:) = pt3d(:,jj,:) 
     2604      ! 
     2605      DO jk = 1, jpk 
     2606         DO jj = nlcj - ijpj +1, nlcj          ! put in xnorthloc the last 4 jlines of pt3d 
     2607            ij = jj - nlcj + ijpj 
     2608            xnorthloc(:,ij,jk) = pt3d(:,jj,jk) 
     2609         END DO 
    26052610      END DO 
    26062611      ! 
    26072612      !                                     ! Build in procs of ncomm_north the xnorthgloio 
    26082613      itaille = jpi * jpk * ijpj 
     2614 
     2615 
    26092616      IF ( l_north_nogather ) THEN 
    26102617         ! 
    2611          ! Avoid the use of mpi_allgather by exchanging only with the processes already identified 
     2618         ! Avoid the use of mpi_allgather by exchanging only with the processes already identified  
    26122619         ! (in nemo_northcomms) as being  involved in this process' northern boundary exchange 
    26132620         ! 
    2614          DO jj = nlcj-ijpj+1, nlcj          ! First put local values into the global array 
    2615             ij = jj - nlcj + ijpj 
    2616             DO ji = 1, nlci 
    2617                tab_3d(ji+nimpp-1,ij,:) = pt3d(ji,jj,:) 
    2618             END DO 
    2619          END DO 
    2620  
    2621          ! 
    2622          ! Set the exchange type in order to access the correct list of active neighbours 
    2623          ! 
    2624          SELECT CASE ( cd_type ) 
    2625             CASE ( 'T' , 'W' ) 
    2626                ityp = 1 
    2627             CASE ( 'U' ) 
    2628                ityp = 2 
    2629             CASE ( 'V' ) 
    2630                ityp = 3 
    2631             CASE ( 'F' ) 
    2632                ityp = 4 
    2633             CASE ( 'I' ) 
    2634                ityp = 5 
    2635             CASE DEFAULT 
    2636                ityp = -1                    ! Set a default value for unsupported types which 
    2637                                             ! will cause a fallback to the mpi_allgather method 
    2638          END SELECT 
    2639          IF ( ityp .gt. 0 ) THEN 
    2640  
    2641             DO jr = 1,nsndto(ityp) 
    2642                CALL mppsend(5, xnorthloc, itaille, isendto(jr,ityp), ml_req_nf(jr) ) 
    2643             END DO 
    2644             DO jr = 1,nsndto(ityp) 
    2645                CALL mpprecv(5, foldwk, itaille, isendto(jr,ityp)) 
    2646                iproc = isendto(jr,ityp) + 1 
    2647                ildi = nldit (iproc) 
    2648                ilei = nleit (iproc) 
    2649                iilb = nimppt(iproc) 
    2650                DO jj = 1, ijpj 
    2651                   DO ji = ildi, ilei 
    2652                      tab_3d(ji+iilb-1,jj,:) = foldwk(ji,jj,:) 
    2653                   END DO 
     2621 
     2622         ztabr_3d(:,:,:) = 0 
     2623 
     2624         DO jk = 1, jpk 
     2625            DO jj = nlcj-ijpj+1, nlcj          ! First put local values into the global array 
     2626               ij = jj - nlcj + ijpj 
     2627               DO ji = 1, nlci 
     2628                  ztabl_3d(ji,ij,jk) = pt3d(ji,jj,jk) 
    26542629               END DO 
    26552630            END DO 
    2656             IF (l_isend) THEN 
    2657                DO jr = 1,nsndto(ityp) 
    2658                   CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err) 
     2631         END DO 
     2632 
     2633         DO jr = 1,nsndto 
     2634            IF (isendto(jr) .ne. narea) CALL mppsend(5, xnorthloc, itaille, isendto(jr)-1, ml_req_nf(jr)) 
     2635         END DO 
     2636         DO jr = 1,nsndto 
     2637            iproc = isendto(jr) 
     2638            ildi = nldit (iproc) 
     2639            ilei = nleit (iproc) 
     2640            iilb = nimppt(isendto(jr)) - nimppt(isendto(1)) 
     2641            IF(isendto(jr) .ne. narea) THEN 
     2642              CALL mpprecv(5, foldwk, itaille, isendto(jr)-1) 
     2643              DO jk = 1, jpk 
     2644                 DO jj = 1, ijpj 
     2645                    DO ji = 1, ilei 
     2646                       ztabr_3d(iilb+ji,jj,jk) = foldwk(ji,jj,jk) 
     2647                    END DO 
     2648                 END DO 
     2649              END DO 
     2650           ELSE 
     2651              DO jk = 1, jpk 
     2652                 DO jj = 1, ijpj 
     2653                    DO ji = 1, ilei 
     2654                       ztabr_3d(iilb+ji,jj,jk) = pt3d(ji,nlcj-ijpj+jj,jk) 
     2655                    END DO 
     2656                 END DO 
     2657              END DO 
     2658           ENDIF 
     2659         END DO 
     2660         IF (l_isend) THEN 
     2661            DO jr = 1,nsndto 
     2662               IF (isendto(jr) .ne. narea) CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err) 
     2663            END DO 
     2664         ENDIF 
     2665         CALL mpp_lbc_nfd( ztabl_3d, ztabr_3d, cd_type, psgn )   ! North fold boundary condition 
     2666         ! 
     2667         DO jk=1, jpk 
     2668            DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to pt3d 
     2669               ij = jj - nlcj + ijpj 
     2670               DO ji= 1, nlci 
     2671                  pt3d(ji,jj,jk) = ztabl_3d(ji,ij,jk) 
    26592672               END DO 
    2660             ENDIF 
    2661  
    2662          ENDIF 
    2663  
    2664       ENDIF 
    2665  
    2666       IF ( ityp .lt. 0 ) THEN 
     2673            END DO 
     2674         END DO 
     2675         ! 
     2676 
     2677      ELSE 
    26672678         CALL MPI_ALLGATHER( xnorthloc  , itaille, MPI_DOUBLE_PRECISION,                & 
    26682679            &                xnorthgloio, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr ) 
    … …  
    26732684            ilei  = nleit (iproc) 
    26742685            iilb  = nimppt(iproc) 
    2675             DO jj = 1, ijpj 
    2676                DO ji = ildi, ilei 
    2677                   tab_3d(ji+iilb-1,jj,:) = xnorthgloio(ji,jj,:,jr) 
     2686            DO jk=1, jpk 
     2687               DO jj = 1, ijpj 
     2688                  DO ji = ildi, ilei 
     2689                     tab_3d(ji+iilb-1,jj,jk) = xnorthgloio(ji,jj,jk,jr) 
     2690                  END DO 
    26782691               END DO 
    26792692            END DO 
    26802693         END DO 
    2681       ENDIF 
    2682       ! 
    2683       ! The tab_3d array has been either: 
    2684       !  a. Fully populated by the mpi_allgather operation or 
    2685       !  b. Had the active points for this domain and northern neighbours populated 
    2686       !     by peer to peer exchanges 
    2687       ! Either way the array may be folded by lbc_nfd and the result for the span of 
    2688       ! this domain will be identical. 
    2689       ! 
    2690       CALL lbc_nfd( tab_3d, cd_type, psgn )   ! North fold boundary condition 
    2691       ! 
    2692       DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to pt3d 
    2693          ij = jj - nlcj + ijpj 
    2694          DO ji= 1, nlci 
    2695             pt3d(ji,jj,:) = tab_3d(ji+nimpp-1,ij,:) 
    2696          END DO 
    2697       END DO 
    2698       ! 
     2694         CALL lbc_nfd( tab_3d, cd_type, psgn )   ! North fold boundary condition 
     2695         ! 
     2696         DO jk=1, jpk 
     2697            DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to pt3d 
     2698               ij = jj - nlcj + ijpj 
     2699               DO ji= 1, nlci 
     2700                  pt3d(ji,jj,jk) = tab_3d(ji+nimpp-1,ij,jk) 
     2701               END DO 
     2702            END DO 
     2703         END DO 
     2704         ! 
     2705      ENDIF 
     2706 
    26992707   END SUBROUTINE mpp_lbc_north_3d 
    27002708 
    … …  
    27142722      !! 
    27152723      !!---------------------------------------------------------------------- 
    2716       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pt2d      ! 3D array on which the b.c. is applied 
    2717       CHARACTER(len=1)            , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points 
     2724      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pt2d      ! 2D array on which the b.c. is applied 
     2725      CHARACTER(len=1)            , INTENT(in   ) ::   cd_type   ! nature of pt2d grid-points 
    27182726      !                                                          !   = T ,  U , V , F or W  gridpoints 
    2719       REAL(wp)                    , INTENT(in   ) ::   psgn      ! = -1. the sign change across the north fold 
     2727      REAL(wp)                    , INTENT(in   ) ::   psgn      ! = -1. the sign change across the north fold  
    27202728      !!                                                             ! =  1. , the sign is kept 
    27212729      INTEGER ::   ji, jj, jr 
    27222730      INTEGER ::   ierr, itaille, ildi, ilei, iilb 
    27232731      INTEGER ::   ijpj, ijpjm1, ij, iproc 
    2724       INTEGER, DIMENSION (jpmaxngh)      ::   ml_req_nf          ! for mpi_isend when avoiding mpi_allgather 
     2732      INTEGER, DIMENSION (jpmaxngh)      ::   ml_req_nf          !for mpi_isend when avoiding mpi_allgather 
    27252733      INTEGER                            ::   ml_err             ! for mpi_isend when avoiding mpi_allgather 
    27262734      INTEGER, DIMENSION(MPI_STATUS_SIZE)::   ml_stat            ! for mpi_isend when avoiding mpi_allgather 
    2727       !!---------------------------------------------------------------------- 
    2728       ! 
     2735      INTEGER :: istatus(mpi_status_size) 
     2736      INTEGER :: iflag 
     2737      !!---------------------------------------------------------------------- 
     2738      ! 
     2739 
    27292740      ijpj   = 4 
    2730       ityp = -1 
    27312741      ijpjm1 = 3 
    2732       tab_2d(:,:) = 0.e0 
    27332742      ! 
    27342743      DO jj = nlcj-ijpj+1, nlcj             ! put in xnorthloc_2d the last 4 jlines of pt2d 
    … …  
    27412750      IF ( l_north_nogather ) THEN 
    27422751         ! 
    2743          ! Avoid the use of mpi_allgather by exchanging only with the processes already identified 
     2752         ! Avoid the use of mpi_allgather by exchanging only with the processes already identified  
    27442753         ! (in nemo_northcomms) as being  involved in this process' northern boundary exchange 
    27452754         ! 
     2755 
     2756         ztabr_2d(:,:) = 0 
     2757 
    27462758         DO jj = nlcj-ijpj+1, nlcj          ! First put local values into the global array 
    27472759            ij = jj - nlcj + ijpj 
    27482760            DO ji = 1, nlci 
    2749                tab_2d(ji+nimpp-1,ij) = pt2d(ji,jj) 
     2761               ztabl_2d(ji,ij) = pt2d(ji,jj) 
    27502762            END DO 
    27512763         END DO 
    27522764 
    2753          ! 
    2754          ! Set the exchange type in order to access the correct list of active neighbours 
    2755          ! 
    2756          SELECT CASE ( cd_type ) 
    2757             CASE ( 'T' , 'W' ) 
    2758                ityp = 1 
    2759             CASE ( 'U' ) 
    2760                ityp = 2 
    2761             CASE ( 'V' ) 
    2762                ityp = 3 
    2763             CASE ( 'F' ) 
    2764                ityp = 4 
    2765             CASE ( 'I' ) 
    2766                ityp = 5 
    2767             CASE DEFAULT 
    2768                ityp = -1                    ! Set a default value for unsupported types which 
    2769                                             ! will cause a fallback to the mpi_allgather method 
    2770          END SELECT 
    2771  
    2772          IF ( ityp .gt. 0 ) THEN 
    2773  
    2774             DO jr = 1,nsndto(ityp) 
    2775                CALL mppsend(5, xnorthloc_2d, itaille, isendto(jr,ityp), ml_req_nf(jr) ) 
     2765         DO jr = 1,nsndto 
     2766            IF (isendto(jr) .ne. narea) CALL mppsend(5, xnorthloc_2d, itaille, isendto(jr)-1, ml_req_nf(jr)) 
     2767         END DO 
     2768         DO jr = 1,nsndto 
     2769            iproc = isendto(jr) 
     2770            ildi = nldit (iproc) 
     2771            ilei = nleit (iproc) 
     2772            iilb = nimppt(isendto(jr)) - nimppt(isendto(1)) 
     2773            IF(isendto(jr) .ne. narea) THEN 
     2774              CALL mpprecv(5, foldwk_2d, itaille, isendto(jr)-1) 
     2775              DO jj = 1, ijpj 
     2776                 DO ji = 1, ilei 
     2777                    ztabr_2d(iilb+ji,jj) = foldwk_2d(ji,jj) 
     2778                 END DO 
     2779              END DO 
     2780            ELSE 
     2781              DO jj = 1, ijpj 
     2782                 DO ji = 1, ilei 
     2783                    ztabr_2d(iilb+ji,jj) = pt2d(ji,nlcj-ijpj+jj) 
     2784                 END DO 
     2785              END DO 
     2786            ENDIF 
     2787         END DO 
     2788         IF (l_isend) THEN 
     2789            DO jr = 1,nsndto 
     2790               IF (isendto(jr) .ne. narea) CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err) 
    27762791            END DO 
    2777             DO jr = 1,nsndto(ityp) 
    2778                CALL mpprecv(5, foldwk_2d, itaille, isendto(jr,ityp)) 
    2779                iproc = isendto(jr,ityp) + 1 
    2780                ildi = nldit (iproc) 
    2781                ilei = nleit (iproc) 
    2782                iilb = nimppt(iproc) 
    2783                DO jj = 1, ijpj 
    2784                   DO ji = ildi, ilei 
    2785                      tab_2d(ji+iilb-1,jj) = foldwk_2d(ji,jj) 
    2786                   END DO 
    2787                END DO 
     2792         ENDIF 
     2793         CALL mpp_lbc_nfd( ztabl_2d, ztabr_2d, cd_type, psgn )   ! North fold boundary condition 
     2794         ! 
     2795         DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to pt2d 
     2796            ij = jj - nlcj + ijpj 
     2797            DO ji = 1, nlci 
     2798               pt2d(ji,jj) = ztabl_2d(ji,ij) 
    27882799            END DO 
    2789             IF (l_isend) THEN 
    2790                DO jr = 1,nsndto(ityp) 
    2791                   CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err) 
    2792                END DO 
    2793             ENDIF 
    2794  
    2795          ENDIF 
    2796  
    2797       ENDIF 
    2798  
    2799       IF ( ityp .lt. 0 ) THEN 
     2800         END DO 
     2801         ! 
     2802 
     2803      ELSE 
    28002804         CALL MPI_ALLGATHER( xnorthloc_2d  , itaille, MPI_DOUBLE_PRECISION,        & 
    28012805            &                xnorthgloio_2d, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr ) 
    … …  
    28122816            END DO 
    28132817         END DO 
    2814       ENDIF 
    2815       ! 
    2816       ! The tab array has been either: 
    2817       !  a. Fully populated by the mpi_allgather operation or 
    2818       !  b. Had the active points for this domain and northern neighbours populated 
    2819       !     by peer to peer exchanges 
    2820       ! Either way the array may be folded by lbc_nfd and the result for the span of 
    2821       ! this domain will be identical. 
    2822       ! 
    2823       CALL lbc_nfd( tab_2d, cd_type, psgn )   ! North fold boundary condition 
    2824       ! 
    2825       ! 
    2826       DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to pt2d 
    2827          ij = jj - nlcj + ijpj 
    2828          DO ji = 1, nlci 
    2829             pt2d(ji,jj) = tab_2d(ji+nimpp-1,ij) 
    2830          END DO 
    2831       END DO 
    2832       ! 
     2818         CALL lbc_nfd( tab_2d, cd_type, psgn )   ! North fold boundary condition 
     2819         ! 
     2820         DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to pt2d 
     2821            ij = jj - nlcj + ijpj 
     2822            DO ji = 1, nlci 
     2823               pt2d(ji,jj) = tab_2d(ji+nimpp-1,ij) 
     2824            END DO 
     2825         END DO 
     2826         ! 
     2827      ENDIF 
    28332828   END SUBROUTINE mpp_lbc_north_2d 
    28342829 
    … …  
    28602855      ! 
    28612856      ijpj=4 
    2862       tab_e(:,:) = 0.e0 
    28632857 
    28642858      ij=0 

  • branches/2013/dev_CMCC_INGV_2013/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90

    r3851 r4201  
    77   !!                 !  05-2008  (S. Alderson) Modified for Interpolation in memory 
    88   !!                 !                         from input grid to model grid 
     9   !!                 !  10-2013  (D. Delrosso, P. Oddo) implement suppression of  
     10   !!                 !                         land point prior to interpolation 
    911   !!---------------------------------------------------------------------- 
    1012 
    … …  
    2224   USE wrk_nemo        ! work arrays 
    2325   USE ioipsl, ONLY :   ymds2ju, ju2ymds   ! for calendar 
    24  
     26   USE sbc_oce 
     27    
    2528   IMPLICIT NONE 
    2629   PRIVATE    
    … …  
    4043      !                                     ! a string starting with "U" or "V" for each component    
    4144      !                                     ! chars 2 onwards identify which components go together   
     45      CHARACTER(len = 34)  ::   lname       ! generic name of a NetCDF land/sea mask file to be used, blank if not  
     46      !                                     ! 0=sea 1=land 
    4247   END TYPE FLD_N 
    4348 
    … …  
    6065      LOGICAL, DIMENSION(2)           ::   rotn         ! flag to indicate whether before/after field has been rotated 
    6166      INTEGER                         ::   nreclast     ! last record to be read in the current file 
     67      CHARACTER(len = 256)            ::   lsmname      ! current name of the NetCDF mask file acting as a key 
    6268   END TYPE FLD 
    6369 
    … …  
    95101   TYPE( WGT ), DIMENSION(tot_wgts)   ::   ref_wgts     ! array of wgts 
    96102   INTEGER                            ::   nxt_wgt = 1  ! point to next available space in ref_wgts array 
     103   REAL(wp), PARAMETER                ::   undeff_lsm = -999.00_wp 
    97104 
    98105!$AGRIF_END_DO_NOT_TREAT 
    … …  
    591598      ELSE IF( LEN(TRIM(sdjf%wgtname)) > 0 ) THEN 
    592599         CALL wgt_list( sdjf, iw ) 
    593          IF( sdjf%ln_tint ) THEN   ;   CALL fld_interp( sdjf%num, sdjf%clvar, iw , ipk  , sdjf%fdta(:,:,:,2), sdjf%nrec_a(1) ) 
    594          ELSE                      ;   CALL fld_interp( sdjf%num, sdjf%clvar, iw , ipk  , sdjf%fnow(:,:,:  ), sdjf%nrec_a(1) ) 
     600         IF( sdjf%ln_tint ) THEN   ;   CALL fld_interp( sdjf%num, sdjf%clvar, iw , ipk  , sdjf%fdta(:,:,:,2), sdjf%nrec_a(1), sdjf%lsmname ) 
     601         ELSE                      ;   CALL fld_interp( sdjf%num, sdjf%clvar, iw , ipk  , sdjf%fnow(:,:,:  ), sdjf%nrec_a(1), sdjf%lsmname ) 
    595602         ENDIF 
    596603      ELSE 
    … …  
    856863         sdf(jf)%wgtname    = " " 
    857864         IF( LEN( TRIM(sdf_n(jf)%wname) ) > 0 )   sdf(jf)%wgtname = TRIM( cdir )//TRIM( sdf_n(jf)%wname ) 
     865         sdf(jf)%lsmname = " " 
     866         IF( LEN( TRIM(sdf_n(jf)%lname) ) > 0 )   sdf(jf)%lsmname = TRIM( cdir )//TRIM( sdf_n(jf)%lname ) 
    858867         sdf(jf)%vcomp      = sdf_n(jf)%vcomp 
    859868         sdf(jf)%rotn(:)    = .TRUE.   ! pretend to be rotated -> won't try to rotate data before the first call to fld_get 
    … …  
    878887               &                          ' weights    : '    , TRIM( sdf(jf)%wgtname    ),   & 
    879888               &                          ' pairing    : '    , TRIM( sdf(jf)%vcomp      ),   & 
    880                &                          ' data type: '      ,       sdf(jf)%cltype 
     889               &                          ' data type: '      ,       sdf(jf)%cltype      ,   & 
     890               &                          ' land/sea mask:'   , TRIM( sdf(jf)%lsmname    ) 
    881891            call flush(numout) 
    882892         END DO 
    … …  
    10981108 
    10991109 
    1100    SUBROUTINE fld_interp( num, clvar, kw, kk, dta, nrec ) 
     1110   SUBROUTINE apply_seaoverland(clmaskfile,zfieldo,jpi1_lsm,jpi2_lsm,jpj1_lsm, & 
     1111                          &      jpj2_lsm,itmpi,itmpj,itmpz,rec1_lsm,recn_lsm) 
     1112      !!--------------------------------------------------------------------- 
     1113      !!                    ***  ROUTINE apply_seaoverland  *** 
     1114      !! 
     1115      !! ** Purpose :   avoid spurious fluxes in coastal or near-coastal areas 
     1116      !!                due to the wrong usage of "land" values from the coarse 
     1117      !!                atmospheric model when spatial interpolation is required 
     1118      !!      D. Delrosso INGV           
     1119      !!----------------------------------------------------------------------  
     1120      INTEGER                                   :: inum,jni,jnj,jnz,jc                  ! temporary indices 
     1121      INTEGER,                   INTENT(in)     :: itmpi,itmpj,itmpz                    ! lengths 
     1122      INTEGER,                   INTENT(in)     :: jpi1_lsm,jpi2_lsm,jpj1_lsm,jpj2_lsm  ! temporary indices 
     1123      INTEGER, DIMENSION(3),     INTENT(in)     :: rec1_lsm,recn_lsm                    ! temporary arrays for start and length 
     1124      REAL(wp),DIMENSION (:,:,:),INTENT(inout)  :: zfieldo                              ! input/output array for seaoverland application 
     1125      REAL(wp),DIMENSION (:,:,:),ALLOCATABLE    :: zslmec1                              ! temporary array for land point detection 
     1126      REAL(wp),DIMENSION (:,:),  ALLOCATABLE    :: zfieldn                              ! array of forcing field with undeff for land points 
     1127      REAL(wp),DIMENSION (:,:),  ALLOCATABLE    :: zfield                               ! array of forcing field 
     1128      CHARACTER (len=100),       INTENT(in)     :: clmaskfile                           ! land/sea mask file name 
     1129      !!--------------------------------------------------------------------- 
     1130      ALLOCATE ( zslmec1(itmpi,itmpj,itmpz) ) 
     1131      ALLOCATE ( zfieldn(itmpi,itmpj) ) 
     1132      ALLOCATE ( zfield(itmpi,itmpj) ) 
     1133 
     1134      ! Retrieve the land sea mask data 
     1135      CALL iom_open( clmaskfile, inum ) 
     1136      SELECT CASE( SIZE(zfieldo(jpi1_lsm:jpi2_lsm,jpj1_lsm:jpj2_lsm,:),3) ) 
     1137      CASE(1) 
     1138           CALL iom_get( inum, jpdom_unknown, 'LSM', zslmec1(jpi1_lsm:jpi2_lsm,jpj1_lsm:jpj2_lsm,1), 1, rec1_lsm, recn_lsm) 
     1139      CASE DEFAULT 
     1140           CALL iom_get( inum, jpdom_unknown, 'LSM', zslmec1(jpi1_lsm:jpi2_lsm,jpj1_lsm:jpj2_lsm,:), 1, rec1_lsm, recn_lsm) 
     1141      END SELECT 
     1142      CALL iom_close( inum ) 
     1143 
     1144      DO jnz=1,rec1_lsm(3)                            !! Loop over k dimension 
     1145 
     1146         DO jni=1,itmpi                               !! copy the original field into a tmp array 
     1147            DO jnj=1,itmpj                            !! substituting undeff over land points 
     1148            zfieldn(jni,jnj) = zfieldo(jni,jnj,jnz) 
     1149               IF ( zslmec1(jni,jnj,jnz) == 1. ) THEN 
     1150                  zfieldn(jni,jnj) = undeff_lsm 
     1151               ENDIF 
     1152            END DO 
     1153         END DO 
     1154   
     1155      CALL seaoverland(zfieldn,itmpi,itmpj,zfield) 
     1156      DO jc=1,nn_lsm 
     1157         CALL seaoverland(zfield,itmpi,itmpj,zfield) 
     1158      END DO 
     1159 
     1160      !   Check for Undeff and substitute original values 
     1161      IF(ANY(zfield==undeff_lsm)) THEN 
     1162         DO jni=1,itmpi 
     1163            DO jnj=1,itmpj 
     1164               IF (zfield(jni,jnj)==undeff_lsm) THEN 
     1165                  zfield(jni,jnj) = zfieldo(jni,jnj,jnz) 
     1166               ENDIF 
     1167            ENDDO 
     1168         ENDDO 
     1169      ENDIF 
     1170 
     1171      zfieldo(:,:,jnz)=zfield(:,:) 
     1172 
     1173      END DO                          !! End Loop over k dimension 
     1174 
     1175      DEALLOCATE ( zslmec1 ) 
     1176      DEALLOCATE ( zfieldn ) 
     1177      DEALLOCATE ( zfield ) 
     1178 
     1179   END SUBROUTINE apply_seaoverland  
     1180 
     1181 
     1182   SUBROUTINE seaoverland(zfieldn,ileni,ilenj,zfield) 
     1183      !!--------------------------------------------------------------------- 
     1184      !!                    ***  ROUTINE seaoverland  *** 
     1185      !! 
     1186      !! ** Purpose :   create shifted matrices for seaoverland application   
     1187      !!      D. Delrosso INGV 
     1188      !!----------------------------------------------------------------------  
     1189      INTEGER,INTENT(in)                       :: ileni,ilenj              ! lengths  
     1190      REAL,DIMENSION (ileni,ilenj),INTENT(in)  :: zfieldn                  ! array of forcing field with undeff for land points 
     1191      REAL,DIMENSION (ileni,ilenj),INTENT(out) :: zfield                   ! array of forcing field 
     1192      REAL,DIMENSION (ileni,ilenj)             :: zmat1,zmat2,zmat3,zmat4  ! temporary arrays for seaoverland application 
     1193      REAL,DIMENSION (ileni,ilenj)             :: zmat5,zmat6,zmat7,zmat8  ! temporary arrays for seaoverland application 
     1194      REAL,DIMENSION (ileni,ilenj)             :: zlsm2d                   ! temporary arrays for seaoverland application 
     1195      REAL,DIMENSION (ileni,ilenj,8)           :: zlsm3d                   ! temporary arrays for seaoverland application 
     1196      LOGICAL,DIMENSION (ileni,ilenj,8)        :: ll_msknan3d              ! logical mask for undeff detection 
     1197      LOGICAL,DIMENSION (ileni,ilenj)          :: ll_msknan2d              ! logical mask for undeff detection 
     1198      !!----------------------------------------------------------------------  
     1199      zmat8 = eoshift(zfieldn   ,  SHIFT=-1, BOUNDARY = (/zfieldn(:,1)/)    ,DIM=2) 
     1200      zmat1 = eoshift(zmat8     ,  SHIFT=-1, BOUNDARY = (/zmat8(1,:)/)      ,DIM=1) 
     1201      zmat2 = eoshift(zfieldn   ,  SHIFT=-1, BOUNDARY = (/zfieldn(1,:)/)    ,DIM=1) 
     1202      zmat4 = eoshift(zfieldn   ,  SHIFT= 1, BOUNDARY = (/zfieldn(:,ilenj)/),DIM=2) 
     1203      zmat3 = eoshift(zmat4     ,  SHIFT=-1, BOUNDARY = (/zmat4(1,:)/)      ,DIM=1) 
     1204      zmat5 = eoshift(zmat4     ,  SHIFT= 1, BOUNDARY = (/zmat4(ileni,:)/)  ,DIM=1) 
     1205      zmat6 = eoshift(zfieldn   ,  SHIFT= 1, BOUNDARY = (/zfieldn(ileni,:)/),DIM=1) 
     1206      zmat7 = eoshift(zmat8     ,  SHIFT= 1, BOUNDARY = (/zmat8(ileni,:)/)  ,DIM=1) 
     1207 
     1208      zlsm3d  = RESHAPE( (/ zmat1, zmat2, zmat3, zmat4, zmat5, zmat6, zmat7, zmat8 /), (/ ileni, ilenj, 8 /)) 
     1209      ll_msknan3d = .not.(zlsm3d==undeff_lsm) 
     1210      ll_msknan2d = .not.(zfieldn==undeff_lsm)  ! FALSE where is Undeff (land) 
     1211      zlsm2d = (SUM ( zlsm3d, 3 , ll_msknan3d ) )/(MAX(1,(COUNT( ll_msknan3d , 3 ))   )) 
     1212      WHERE ((COUNT( ll_msknan3d , 3 )) == 0.0_wp)  zlsm2d = undeff_lsm 
     1213      zfield = MERGE (zfieldn,zlsm2d,ll_msknan2d) 
     1214   END SUBROUTINE seaoverland 
     1215 
     1216 
     1217   SUBROUTINE fld_interp( num, clvar, kw, kk, dta,  & 
     1218                          &         nrec, lsmfile)       
    11011219      !!--------------------------------------------------------------------- 
    11021220      !!                    ***  ROUTINE fld_interp  *** 
    … …  
    11111229      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   dta     ! output field on model grid 
    11121230      INTEGER                   , INTENT(in   ) ::   nrec    ! record number to read (ie time slice) 
     1231      CHARACTER(LEN=*)          , INTENT(in   ) ::   lsmfile ! land sea mask file name 
    11131232      !!  
    1114       INTEGER, DIMENSION(3) ::   rec1,recn   ! temporary arrays for start and length 
    1115       INTEGER ::  jk, jn, jm           ! loop counters 
    1116       INTEGER ::  ni, nj               ! lengths 
    1117       INTEGER ::  jpimin,jpiwid        ! temporary indices 
    1118       INTEGER ::  jpjmin,jpjwid        ! temporary indices 
    1119       INTEGER ::  jpi1,jpi2,jpj1,jpj2  ! temporary indices 
     1233      REAL(wp),DIMENSION(:,:,:),ALLOCATABLE     ::   ztmp_fly_dta,zfieldo                  ! temporary array of values on input grid 
     1234      INTEGER, DIMENSION(3)                     ::   rec1,recn                             ! temporary arrays for start and length 
     1235      INTEGER, DIMENSION(3)                     ::   rec1_lsm,recn_lsm                     ! temporary arrays for start and length in case of seaoverland 
     1236      INTEGER                                   ::   ii_lsm1,ii_lsm2,ij_lsm1,ij_lsm2       ! temporary indices 
     1237      INTEGER                                   ::   jk, jn, jm, jir, jjr                  ! loop counters 
     1238      INTEGER                                   ::   ni, nj                                ! lengths 
     1239      INTEGER                                   ::   jpimin,jpiwid                         ! temporary indices 
     1240      INTEGER                                   ::   jpimin_lsm,jpiwid_lsm                 ! temporary indices 
     1241      INTEGER                                   ::   jpjmin,jpjwid                         ! temporary indices 
     1242      INTEGER                                   ::   jpjmin_lsm,jpjwid_lsm                 ! temporary indices 
     1243      INTEGER                                   ::   jpi1,jpi2,jpj1,jpj2                   ! temporary indices 
     1244      INTEGER                                   ::   jpi1_lsm,jpi2_lsm,jpj1_lsm,jpj2_lsm   ! temporary indices 
     1245      INTEGER                                   ::   itmpi,itmpj,itmpz                     ! lengths 
     1246       
    11201247      !!---------------------------------------------------------------------- 
    11211248      ! 
    … …  
    11471274      jpj2 = jpj1 + recn(2) - 1 
    11481275 
    1149       ref_wgts(kw)%fly_dta(:,:,:) = 0.0 
    1150       SELECT CASE( SIZE(ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,:),3) ) 
    1151       CASE(1) 
    1152            CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,1), nrec, rec1, recn) 
    1153       CASE DEFAULT 
    1154            CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,:), nrec, rec1, recn) 
    1155       END SELECT  
     1276 
     1277      IF( LEN( TRIM(lsmfile) ) > 0 ) THEN 
     1278      !! indeces for ztmp_fly_dta 
     1279      ! -------------------------- 
     1280         rec1_lsm(1)=MAX(rec1(1)-nn_lsm,1)  ! starting index for enlarged external data, x direction 
     1281         rec1_lsm(2)=MAX(rec1(2)-nn_lsm,1)  ! starting index for enlarged external data, y direction 
     1282         rec1_lsm(3) = 1                    ! vertical dimension 
     1283         recn_lsm(1)=MIN(rec1(1)-rec1_lsm(1)+recn(1)+nn_lsm,ref_wgts(kw)%ddims(1)-rec1_lsm(1)) ! n points in x direction 
     1284         recn_lsm(2)=MIN(rec1(2)-rec1_lsm(2)+recn(2)+nn_lsm,ref_wgts(kw)%ddims(2)-rec1_lsm(2)) ! n points in y direction 
     1285         recn_lsm(3) = kk                   ! number of vertical levels in the input file 
     1286 
     1287      !  Avoid out of bound 
     1288         jpimin_lsm = MAX( rec1_lsm(1)+1, 1 ) 
     1289         jpjmin_lsm = MAX( rec1_lsm(2)+1, 1 ) 
     1290         jpiwid_lsm = MIN( recn_lsm(1)-2,ref_wgts(kw)%ddims(1)-rec1(1)+1) 
     1291         jpjwid_lsm = MIN( recn_lsm(2)-2,ref_wgts(kw)%ddims(2)-rec1(2)+1) 
     1292 
     1293         jpi1_lsm = 2+rec1_lsm(1)-jpimin_lsm 
     1294         jpj1_lsm = 2+rec1_lsm(2)-jpjmin_lsm 
     1295         jpi2_lsm = jpi1_lsm + recn_lsm(1) - 1 
     1296         jpj2_lsm = jpj1_lsm + recn_lsm(2) - 1 
     1297 
     1298 
     1299         itmpi=SIZE(ztmp_fly_dta(jpi1_lsm:jpi2_lsm,jpj1_lsm:jpj2_lsm,:),1) 
     1300         itmpj=SIZE(ztmp_fly_dta(jpi1_lsm:jpi2_lsm,jpj1_lsm:jpj2_lsm,:),2) 
     1301         itmpz=kk 
     1302         ALLOCATE(ztmp_fly_dta(itmpi,itmpj,itmpz)) 
     1303         ztmp_fly_dta(:,:,:) = 0.0 
     1304         SELECT CASE( SIZE(ztmp_fly_dta(jpi1_lsm:jpi2_lsm,jpj1_lsm:jpj2_lsm,:),3) ) 
     1305         CASE(1) 
     1306              CALL iom_get( num, jpdom_unknown, clvar, ztmp_fly_dta(jpi1_lsm:jpi2_lsm,jpj1_lsm:jpj2_lsm,1),   & 
     1307                 &                                                                nrec, rec1_lsm, recn_lsm) 
     1308         CASE DEFAULT 
     1309              CALL iom_get( num, jpdom_unknown, clvar, ztmp_fly_dta(jpi1_lsm:jpi2_lsm,jpj1_lsm:jpj2_lsm,:),   & 
     1310                 &                                                                nrec, rec1_lsm, recn_lsm) 
     1311         END SELECT 
     1312         CALL apply_seaoverland(lsmfile,ztmp_fly_dta(jpi1_lsm:jpi2_lsm,jpj1_lsm:jpj2_lsm,:),                  & 
     1313                 &                                      jpi1_lsm,jpi2_lsm,jpj1_lsm,jpj2_lsm,                  & 
     1314                 &                                      itmpi,itmpj,itmpz,rec1_lsm,recn_lsm) 
     1315 
     1316 
     1317         ! Relative indeces for remapping 
     1318         ii_lsm1 = (rec1(1)-rec1_lsm(1))+1 
     1319         ii_lsm2 = (ii_lsm1+recn(1))-1 
     1320         ij_lsm1 = (rec1(2)-rec1_lsm(2))+1 
     1321         ij_lsm2 = (ij_lsm1+recn(2))-1 
     1322 
     1323         ref_wgts(kw)%fly_dta(:,:,:) = 0.0 
     1324         ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,:) = ztmp_fly_dta(ii_lsm1:ii_lsm2,ij_lsm1:ij_lsm2,:) 
     1325         DEALLOCATE(ztmp_fly_dta) 
     1326 
     1327      ELSE 
     1328          
     1329         ref_wgts(kw)%fly_dta(:,:,:) = 0.0 
     1330         SELECT CASE( SIZE(ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,:),3) ) 
     1331         CASE(1) 
     1332              CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,1), nrec, rec1, recn) 
     1333         CASE DEFAULT 
     1334              CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,:), nrec, rec1, recn) 
     1335         END SELECT  
     1336      ENDIF 
     1337       
    11561338 
    11571339      !! first four weights common to both bilinear and bicubic 

  • branches/2013/dev_CMCC_INGV_2013/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90

    r3905 r4201  
    5252   LOGICAL , PUBLIC ::   ln_cdgw     = .FALSE.   !: true if neutral drag coefficient from wave model 
    5353   LOGICAL , PUBLIC ::   ln_sdw      = .FALSE.   !: true if 3d stokes drift from wave model 
    54  
     54   INTEGER , PUBLIC ::   nn_lsm      = 0         !: Number of iteration if seaoverland is applied 
    5555   !!---------------------------------------------------------------------- 
    5656   !!              Ocean Surface Boundary Condition fields 

  • branches/2013/dev_CMCC_INGV_2013/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90

    r3795 r4201  
    7878         !                                            !* set file information (default values) 
    7979         ! ... default values (NB: frequency positive => hours, negative => months) 
    80          !            !   file   ! frequency !  variable  ! time intep !  clim   ! 'yearly' or ! weights  ! rotation ! 
    81          !            !   name   !  (hours)  !   name     !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs    ! 
    82          sn_apr = FLD_N( 'patm'  ,    24     ,  'patm'    ,  .false.   , .true.  ,   'yearly'  , ''       , ''       ) 
     80         !            !   file   ! frequency !  variable  ! time intep !  clim   ! 'yearly' or ! weights  ! rotation ! land/sea mask ! 
     81         !            !   name   !  (hours)  !   name     !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs    ! filename      ! 
     82         sn_apr = FLD_N( 'patm'  ,    24     ,  'patm'    ,  .false.   , .true.  ,   'yearly'  , ''       , ''       , ''            ) 
    8383         cn_dir  = './'          ! directory in which the Patm data are  
    8484 

  • branches/2013/dev_CMCC_INGV_2013/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90

    r3625 r4201  
    143143 
    144144         ! (NB: frequency positive => hours, negative => months) 
    145          !            !    file    ! frequency ! variable ! time intep !  clim   ! 'yearly' or ! weights  ! rotation ! 
    146          !            !    name    !  (hours)  !  name    !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs    ! 
    147          sn_utau = FLD_N( 'utau'   ,    24     , 'utau'   ,  .true.    , .false. ,   'yearly'  , ''       , ''       )  
    148          sn_vtau = FLD_N( 'vtau'   ,    24     , 'vtau'   ,  .true.    , .false. ,   'yearly'  , ''       , ''       )  
    149          sn_wndm = FLD_N( 'mwnd10m',    24     , 'm_10'   ,  .true.    , .false. ,   'yearly'  , ''       , ''       )  
    150          sn_tair = FLD_N( 'tair10m',    24     , 't_10'   ,  .false.   , .false. ,   'yearly'  , ''       , ''       )  
    151          sn_humi = FLD_N( 'humi10m',    24     , 'q_10'   ,  .false.   , .false. ,   'yearly'  , ''       , ''       )  
    152          sn_ccov = FLD_N( 'ccover' ,    -1     , 'cloud'  ,  .true.    , .false. ,   'yearly'  , ''       , ''       )  
    153          sn_prec = FLD_N( 'precip' ,    -1     , 'precip' ,  .true.    , .false. ,   'yearly'  , ''       , ''       )  
     145         !            !    file    ! frequency ! variable ! time intep !  clim   ! 'yearly' or ! weights  ! rotation ! land/sea mask ! 
     146         !            !    name    !  (hours)  !  name    !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs    ! filename      ! 
     147         sn_utau = FLD_N( 'utau'   ,    24     , 'utau'   ,  .true.    , .false. ,   'yearly'  , ''       , ''       , ''            )  
     148         sn_vtau = FLD_N( 'vtau'   ,    24     , 'vtau'   ,  .true.    , .false. ,   'yearly'  , ''       , ''       , ''            )  
     149         sn_wndm = FLD_N( 'mwnd10m',    24     , 'm_10'   ,  .true.    , .false. ,   'yearly'  , ''       , ''       , ''            )  
     150         sn_tair = FLD_N( 'tair10m',    24     , 't_10'   ,  .false.   , .false. ,   'yearly'  , ''       , ''       , ''            )  
     151         sn_humi = FLD_N( 'humi10m',    24     , 'q_10'   ,  .false.   , .false. ,   'yearly'  , ''       , ''       , ''            )  
     152         sn_ccov = FLD_N( 'ccover' ,    -1     , 'cloud'  ,  .true.    , .false. ,   'yearly'  , ''       , ''       , ''            )  
     153         sn_prec = FLD_N( 'precip' ,    -1     , 'precip' ,  .true.    , .false. ,   'yearly'  , ''       , ''       , ''            )  
    154154 
    155155         REWIND( numnam )                    ! ... read in namlist namsbc_clio 

  • branches/2013/dev_CMCC_INGV_2013/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90

    r3772 r4201  
    139139         ! 
    140140         ! (NB: frequency positive => hours, negative => months) 
    141          !            !    file    ! frequency ! variable ! time intep !  clim   ! 'yearly' or ! weights  ! rotation ! 
    142          !            !    name    !  (hours)  !  name    !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs    ! 
    143          sn_wndi = FLD_N( 'uwnd10m',    24     , 'u_10'   ,  .false.   , .false. ,   'yearly'  , ''       , ''       ) 
    144          sn_wndj = FLD_N( 'vwnd10m',    24     , 'v_10'   ,  .false.   , .false. ,   'yearly'  , ''       , ''       ) 
    145          sn_qsr  = FLD_N( 'qsw'    ,    24     , 'qsw'    ,  .false.   , .false. ,   'yearly'  , ''       , ''       ) 
    146          sn_qlw  = FLD_N( 'qlw'    ,    24     , 'qlw'    ,  .false.   , .false. ,   'yearly'  , ''       , ''       ) 
    147          sn_tair = FLD_N( 'tair10m',    24     , 't_10'   ,  .false.   , .false. ,   'yearly'  , ''       , ''       ) 
    148          sn_humi = FLD_N( 'humi10m',    24     , 'q_10'   ,  .false.   , .false. ,   'yearly'  , ''       , ''       ) 
    149          sn_prec = FLD_N( 'precip' ,    -1     , 'precip' ,  .true.    , .false. ,   'yearly'  , ''       , ''       ) 
    150          sn_snow = FLD_N( 'snow'   ,    -1     , 'snow'   ,  .true.    , .false. ,   'yearly'  , ''       , ''       ) 
    151          sn_tdif = FLD_N( 'taudif' ,    24     , 'taudif' ,  .true.    , .false. ,   'yearly'  , ''       , ''       ) 
     141         !            !    file    ! frequency ! variable ! time intep !  clim   ! 'yearly' or ! weights  ! rotation ! land/sea mask ! 
     142         !            !    name    !  (hours)  !  name    !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs    ! filename      ! 
     143         sn_wndi = FLD_N( 'uwnd10m',    24     , 'u_10'   ,  .false.   , .false. ,   'yearly'  , ''       , ''       , ''            ) 
     144         sn_wndj = FLD_N( 'vwnd10m',    24     , 'v_10'   ,  .false.   , .false. ,   'yearly'  , ''       , ''       , ''            ) 
     145         sn_qsr  = FLD_N( 'qsw'    ,    24     , 'qsw'    ,  .false.   , .false. ,   'yearly'  , ''       , ''       , ''            ) 
     146         sn_qlw  = FLD_N( 'qlw'    ,    24     , 'qlw'    ,  .false.   , .false. ,   'yearly'  , ''       , ''       , ''            ) 
     147         sn_tair = FLD_N( 'tair10m',    24     , 't_10'   ,  .false.   , .false. ,   'yearly'  , ''       , ''       , ''            ) 
     148         sn_humi = FLD_N( 'humi10m',    24     , 'q_10'   ,  .false.   , .false. ,   'yearly'  , ''       , ''       , ''            ) 
     149         sn_prec = FLD_N( 'precip' ,    -1     , 'precip' ,  .true.    , .false. ,   'yearly'  , ''       , ''       , ''            ) 
     150         sn_snow = FLD_N( 'snow'   ,    -1     , 'snow'   ,  .true.    , .false. ,   'yearly'  , ''       , ''       , ''            ) 
     151         sn_tdif = FLD_N( 'taudif' ,    24     , 'taudif' ,  .true.    , .false. ,   'yearly'  , ''       , ''       , ''            ) 
    152152         ! 
    153153         REWIND( numnam )                          ! read in namlist namsbc_core 

  • branches/2013/dev_CMCC_INGV_2013/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_mfs.F90

    r3625 r4201  
    137137            ! 
    138138            ! (NB: frequency positive => hours, negative => months) 
    139             !            !    file     ! frequency !  variable  ! time intep !  clim   ! 'yearly' or ! weights  ! rotation   ! 
    140             !            !    name     !  (hours)  !   name     !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs      ! 
    141             sn_wndi = FLD_N( 'ecmwf'   ,    24     ,  'u10'     ,  .false.   , .false. ,   'daily'   , ''       , ''         ) 
    142             sn_wndj = FLD_N( 'ecmwf'   ,    24     ,  'v10'     ,  .false.   , .false. ,   'daily'   , ''       , ''         ) 
    143             sn_clc  = FLD_N( 'ecmwf'   ,    24     ,  'clc'     ,  .false.   , .false. ,   'daily'   , ''       , ''         ) 
    144             sn_msl  = FLD_N( 'ecmwf'   ,    24     ,  'msl'     ,  .false.   , .false. ,   'daily'   , ''       , ''         ) 
    145             sn_tair = FLD_N( 'ecmwf'   ,    24     ,  't2'      ,  .false.   , .false. ,   'daily'   , ''       , ''         ) 
    146             sn_rhm  = FLD_N( 'ecmwf'   ,    24     ,  'rh'      ,  .false.   , .false. ,   'daily'   , ''       , ''         ) 
    147             sn_prec = FLD_N( 'precip_cmap' ,  -1   ,  'precip'  ,  .true.    ,  .true. ,   'yearly'  , ''       , ''         ) 
     139            !            !    file     ! frequency !  variable  ! time intep !  clim   ! 'yearly' or ! weights  ! rotation   ! land/sea mask ! 
     140            !            !    name     !  (hours)  !   name     !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs      ! filename      ! 
     141            sn_wndi = FLD_N( 'ecmwf'   ,    24     ,  'u10'     ,  .false.   , .false. ,   'daily'   , ''       , ''         , ''            ) 
     142            sn_wndj = FLD_N( 'ecmwf'   ,    24     ,  'v10'     ,  .false.   , .false. ,   'daily'   , ''       , ''         , ''            ) 
     143            sn_clc  = FLD_N( 'ecmwf'   ,    24     ,  'clc'     ,  .false.   , .false. ,   'daily'   , ''       , ''         , ''            ) 
     144            sn_msl  = FLD_N( 'ecmwf'   ,    24     ,  'msl'     ,  .false.   , .false. ,   'daily'   , ''       , ''         , ''            ) 
     145            sn_tair = FLD_N( 'ecmwf'   ,    24     ,  't2'      ,  .false.   , .false. ,   'daily'   , ''       , ''         , ''            ) 
     146            sn_rhm  = FLD_N( 'ecmwf'   ,    24     ,  'rh'      ,  .false.   , .false. ,   'daily'   , ''       , ''         , ''            ) 
     147            sn_prec = FLD_N( 'precip_cmap' ,  -1   ,  'precip'  ,  .true.    ,  .true. ,   'yearly'  , ''       , ''         , ''            ) 
    148148            ! 
    149149            REWIND( numnam )                    ! ... read in namlist namsbc_mfs 

  • branches/2013/dev_CMCC_INGV_2013/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90

    r3625 r4201  
    9292         cn_dir = './'        ! directory in which the model is executed 
    9393         ! ... default values (NB: frequency positive => hours, negative => months) 
    94          !              !  file   ! frequency !  variable  ! time intep !  clim   ! 'yearly' or ! weights  ! rotation  ! 
    95          !              !  name   !  (hours)  !   name     !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs     ! 
    96          sn_utau = FLD_N(  'utau' ,    24     ,  'utau'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        ) 
    97          sn_vtau = FLD_N(  'vtau' ,    24     ,  'vtau'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        ) 
    98          sn_qtot = FLD_N(  'qtot' ,    24     ,  'qtot'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        ) 
    99          sn_qsr  = FLD_N(  'qsr'  ,    24     ,  'qsr'     ,  .false.   , .false. ,   'yearly'  , ''       , ''        ) 
    100          sn_emp  = FLD_N(  'emp'  ,    24     ,  'emp'     ,  .false.   , .false. ,   'yearly'  , ''       , ''        ) 
     94         !              !  file   ! frequency !  variable  ! time intep !  clim   ! 'yearly' or ! weights  ! rotation  ! land/sea mask ! 
     95         !              !  name   !  (hours)  !   name     !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs     ! filename      ! 
     96         sn_utau = FLD_N(  'utau' ,    24     ,  'utau'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        , ''            ) 
     97         sn_vtau = FLD_N(  'vtau' ,    24     ,  'vtau'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        , ''            ) 
     98         sn_qtot = FLD_N(  'qtot' ,    24     ,  'qtot'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        , ''            ) 
     99         sn_qsr  = FLD_N(  'qsr'  ,    24     ,  'qsr'     ,  .false.   , .false. ,   'yearly'  , ''       , ''        , ''            ) 
     100         sn_emp  = FLD_N(  'emp'  ,    24     ,  'emp'     ,  .false.   , .false. ,   'yearly'  , ''       , ''        , ''            ) 
    101101         ! 
    102102         REWIND ( numnam )                         ! read in namlist namflx 

  • branches/2013/dev_CMCC_INGV_2013/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90

    r3625 r4201  
    743743 
    744744         ! (NB: frequency positive => hours, negative => months) 
    745          !            !    file          ! frequency !  variable    ! time intep !  clim   ! 'yearly' or ! weights  ! rotation   ! 
    746          !            !    name          !  (hours)  !   name       !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs      ! 
    747          sn_snow = FLD_N( 'snowfall_1m'  ,    -1.    ,  'snowfall'  ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         )  
    748          sn_rain = FLD_N( 'rainfall_1m'  ,    -1.    ,  'rainfall'  ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         )  
    749          sn_sblm = FLD_N( 'sublim_1m'    ,    -1.    ,  'sublim'    ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ) 
    750          sn_top1 = FLD_N( 'topmeltn1_1m' ,    -1.    ,  'topmeltn1' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ) 
    751          sn_top2 = FLD_N( 'topmeltn2_1m' ,    -1.    ,  'topmeltn2' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ) 
    752          sn_top3 = FLD_N( 'topmeltn3_1m' ,    -1.    ,  'topmeltn3' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ) 
    753          sn_top4 = FLD_N( 'topmeltn4_1m' ,    -1.    ,  'topmeltn4' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ) 
    754          sn_top5 = FLD_N( 'topmeltn5_1m' ,    -1.    ,  'topmeltn5' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ) 
    755          sn_bot1 = FLD_N( 'botmeltn1_1m' ,    -1.    ,  'botmeltn1' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ) 
    756          sn_bot2 = FLD_N( 'botmeltn2_1m' ,    -1.    ,  'botmeltn2' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ) 
    757          sn_bot3 = FLD_N( 'botmeltn3_1m' ,    -1.    ,  'botmeltn3' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ) 
    758          sn_bot4 = FLD_N( 'botmeltn4_1m' ,    -1.    ,  'botmeltn4' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ) 
    759          sn_bot5 = FLD_N( 'botmeltn5_1m' ,    -1.    ,  'botmeltn5' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ) 
     745         !            !    file          ! frequency !  variable    ! time intep !  clim   ! 'yearly' or ! weights  ! rotation   ! land/sea mask ! 
     746         !            !    name          !  (hours)  !   name       !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs      ! filename      ! 
     747         sn_snow = FLD_N( 'snowfall_1m'  ,    -1.    ,  'snowfall'  ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         , ''            )  
     748         sn_rain = FLD_N( 'rainfall_1m'  ,    -1.    ,  'rainfall'  ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         , ''            )  
     749         sn_sblm = FLD_N( 'sublim_1m'    ,    -1.    ,  'sublim'    ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         , ''            ) 
     750         sn_top1 = FLD_N( 'topmeltn1_1m' ,    -1.    ,  'topmeltn1' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         , ''            ) 
     751         sn_top2 = FLD_N( 'topmeltn2_1m' ,    -1.    ,  'topmeltn2' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         , ''            ) 
     752         sn_top3 = FLD_N( 'topmeltn3_1m' ,    -1.    ,  'topmeltn3' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         , ''            ) 
     753         sn_top4 = FLD_N( 'topmeltn4_1m' ,    -1.    ,  'topmeltn4' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         , ''            ) 
     754         sn_top5 = FLD_N( 'topmeltn5_1m' ,    -1.    ,  'topmeltn5' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         , ''            ) 
     755         sn_bot1 = FLD_N( 'botmeltn1_1m' ,    -1.    ,  'botmeltn1' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         , ''            ) 
     756         sn_bot2 = FLD_N( 'botmeltn2_1m' ,    -1.    ,  'botmeltn2' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         , ''            ) 
     757         sn_bot3 = FLD_N( 'botmeltn3_1m' ,    -1.    ,  'botmeltn3' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         , ''            ) 
     758         sn_bot4 = FLD_N( 'botmeltn4_1m' ,    -1.    ,  'botmeltn4' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         , ''            ) 
     759         sn_bot5 = FLD_N( 'botmeltn5_1m' ,    -1.    ,  'botmeltn5' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         , ''            ) 
    760760 
    761761!         REWIND ( numnam )               ! ... at some point might read in from NEMO namelist? 

  • branches/2013/dev_CMCC_INGV_2013/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90

    r3625 r4201  
    7272         cn_dir = './'        ! directory in which the model is executed 
    7373         ! ... default values (NB: frequency positive => hours, negative => months) 
    74          !             !   file    ! frequency !  variable  ! time intep !  clim  ! 'yearly' or ! weights  ! rotation   ! 
    75          !             !   name    !  (hours)  !   name     !   (T/F)    !  (T/F) !  'monthly'  ! filename ! pairs      !  
    76          sn_ice = FLD_N('ice_cover',    -1    ,  'ice_cov' ,  .true.    , .true. ,   'yearly'  , ''       , ''         ) 
     74         !             !   file    ! frequency !  variable  ! time intep !  clim  ! 'yearly' or ! weights  ! rotation   ! land/sea mask ! 
     75         !             !   name    !  (hours)  !   name     !   (T/F)    !  (T/F) !  'monthly'  ! filename ! pairs      ! filename      ! 
     76         sn_ice = FLD_N('ice_cover',    -1     ,  'ice_cov' ,  .true.    , .true. ,   'yearly'  , ''       , ''         , ''            ) 
    7777 
    7878         REWIND ( numnam )               ! ... read in namlist namiif 

  • branches/2013/dev_CMCC_INGV_2013/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

    r4028 r4201  
    8686      NAMELIST/namsbc/ nn_fsbc   , ln_ana    , ln_flx,  ln_blk_clio, ln_blk_core, ln_cpl,   & 
    8787         &             ln_blk_mfs, ln_apr_dyn, nn_ice,  nn_ice_embd, ln_dm2dc   , ln_rnf,   & 
    88          &             ln_ssr    , nn_fwb    , ln_cdgw , ln_wave , ln_sdw 
     88         &             ln_ssr    , nn_fwb    , ln_cdgw , ln_wave , ln_sdw , nn_lsm 
    8989      !!---------------------------------------------------------------------- 
    9090 
    … …  
    128128         WRITE(numout,*) '              FreshWater Budget control  (=0/1/2)        nn_fwb      = ', nn_fwb 
    129129         WRITE(numout,*) '              closed sea (=0/1) (set in namdom)          nn_closea   = ', nn_closea 
     130         WRITE(numout,*) '              n. of iterations if land-sea-mask applied  nn_lsm      = ', nn_lsm 
    130131      ENDIF 
    131132 

  • branches/2013/dev_CMCC_INGV_2013/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90

    r3832 r4201  
    255255      !                                   ! ============ 
    256256      ! (NB: frequency positive => hours, negative => months) 
    257       !            !   file    ! frequency !  variable  ! time intep !  clim  ! 'yearly' or ! weights  ! rotation  ! 
    258       !            !   name    !  (hours)  !   name     !   (T/F)    !  (T/F) !  'monthly'  ! filename ! pairs      ! 
    259       sn_rnf = FLD_N( 'runoffs',    -1     , 'sorunoff' ,  .TRUE.    , .true. ,   'yearly'  , ''       , ''         ) 
    260       sn_cnf = FLD_N( 'runoffs',     0     , 'sorunoff' ,  .FALSE.   , .true. ,   'yearly'  , ''       , ''         ) 
    261  
    262       sn_s_rnf = FLD_N( 'runoffs',  24.  , 'rosaline' ,  .TRUE.    , .true. ,   'yearly'  , ''    , ''  ) 
    263       sn_t_rnf = FLD_N( 'runoffs',  24.  , 'rotemper' ,  .TRUE.    , .true. ,   'yearly'  , ''    , ''  ) 
    264       sn_dep_rnf = FLD_N( 'runoffs',   0.  , 'rodepth'  ,  .FALSE.   , .true. ,   'yearly'  , ''    , ''  ) 
     257      !            !   file        ! frequency !  variable  ! time intep !  clim  ! 'yearly' or ! weights  ! rotation   ! land/sea mask ! 
     258      !            !   name        !  (hours)  !   name     !   (T/F)    !  (T/F) !  'monthly'  ! filename ! pairs      ! filename      ! 
     259      sn_rnf = FLD_N( 'runoffs'    ,    -1     , 'sorunoff' ,  .TRUE.    , .true. ,   'yearly'  , ''       , ''         , ''            ) 
     260      sn_cnf = FLD_N( 'runoffs'    ,     0     , 'sorunoff' ,  .FALSE.   , .true. ,   'yearly'  , ''       , ''         , ''            ) 
     261 
     262      sn_s_rnf = FLD_N( 'runoffs'  ,  24.      , 'rosaline' ,  .TRUE.    , .true. ,   'yearly'  , ''       , ''         , ''            ) 
     263      sn_t_rnf = FLD_N( 'runoffs'  ,  24.      , 'rotemper' ,  .TRUE.    , .true. ,   'yearly'  , ''       , ''         , ''            ) 
     264      sn_dep_rnf = FLD_N( 'runoffs',   0.      , 'rodepth'  ,  .FALSE.   , .true. ,   'yearly'  , ''       , ''         , ''            ) 
    265265      ! 
    266266      REWIND ( numnam )                         ! Read Namelist namsbc_rnf 

  • branches/2013/dev_CMCC_INGV_2013/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90

    r3764 r4201  
    169169      cn_dir  = './'            ! directory in which the model is executed 
    170170      ! ... default values (NB: frequency positive => hours, negative => months) 
    171       !            !   file    ! frequency !  variable  ! time intep !  clim   ! 'yearly' or ! weights  ! rotation   ! 
    172       !            !   name    !  (hours)  !   name     !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs      ! 
    173       sn_sst = FLD_N( 'sst'    ,    24     ,  'sst'     ,  .false.   , .false. ,   'yearly'  , ''       , ''         ) 
    174       sn_sss = FLD_N( 'sss'    ,    -1     ,  'sss'     ,  .true.    , .false. ,   'yearly'  , ''       , ''         ) 
     171      !            !   file    ! frequency !  variable  ! time intep !  clim   ! 'yearly' or ! weights  ! rotation   ! land/sea mask ! 
     172      !            !   name    !  (hours)  !   name     !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs      ! filename      ! 
     173      sn_sst = FLD_N( 'sst'    ,    24     ,  'sst'     ,  .false.   , .false. ,   'yearly'  , ''       , ''         , ''            ) 
     174      sn_sss = FLD_N( 'sss'    ,    -1     ,  'sss'     ,  .true.    , .false. ,   'yearly'  , ''       , ''         , ''            ) 
    175175 
    176176      REWIND( numnam )             !* read in namlist namflx 

  • branches/2013/dev_CMCC_INGV_2013/NEMOGCM/NEMO/OPA_SRC/SBC/sbcwave.F90

    r3680 r4201  
    8484         !                                            !* set file information (default values) 
    8585         ! ... default values (NB: frequency positive => hours, negative => months) 
    86          !              !   file   ! frequency !  variable  ! time intep !  clim   ! 'yearly' or ! weights  ! rotation ! 
    87          !              !   name   !  (hours)  !   name     !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs    ! 
    88          sn_cdg = FLD_N('cdg_wave'  ,    1     ,'drag_coeff',  .true.    , .false. ,   'daily'   , ''       , ''       ) 
    89          sn_usd = FLD_N('sdw_wave'  ,    1     ,'u_sd2d',      .true.    , .false. ,   'daily'   , ''       , ''       ) 
    90          sn_vsd = FLD_N('sdw_wave'  ,    1     ,'v_sd2d',      .true.    , .false. ,   'daily'   , ''       , ''       ) 
    91          sn_wn = FLD_N( 'sdw_wave'  ,    1     ,'wave_num',    .true.    , .false. ,   'daily'   , ''       , ''       ) 
     86         !              !   file   ! frequency !  variable  ! time intep !  clim   ! 'yearly' or ! weights  ! rotation ! land/sea mask ! 
     87         !              !   name   !  (hours)  !   name     !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs    ! filename      ! 
     88         sn_cdg = FLD_N('cdg_wave'  ,    1     ,'drag_coeff',  .true.    , .false. ,   'daily'   , ''       , ''       , ''            ) 
     89         sn_usd = FLD_N('sdw_wave'  ,    1     ,'u_sd2d',      .true.    , .false. ,   'daily'   , ''       , ''       , ''            ) 
     90         sn_vsd = FLD_N('sdw_wave'  ,    1     ,'v_sd2d',      .true.    , .false. ,   'daily'   , ''       , ''       , ''            ) 
     91         sn_wn = FLD_N( 'sdw_wave'  ,    1     ,'wave_num',    .true.    , .false. ,   'daily'   , ''       , ''       , ''            ) 
    9292         cn_dir = './'          ! directory in which the wave data are  
    9393          

  • branches/2013/dev_CMCC_INGV_2013/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90

    r3294 r4201  
    104104         IF(lwp) WRITE(numout,*) '~~~~~~~' 
    105105         ! 
    106          rbcp = 0.25 * (1. + atfp) * (1. + atfp) * ( 1. - atfp)      ! Brown & Campana parameter for semi-implicit hpg 
     106         rbcp = 0.25_wp * (1._wp + atfp) * (1._wp + atfp) * ( 1._wp - atfp)      ! Brown & Campana parameter for semi-implicit hpg 
    107107      ENDIF 
    108108 
    109109      ! Update after tracer on domain lateral boundaries 
    110110      !  
    111       CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1. )      ! local domain boundaries  (T-point, unchanged sign) 
    112       CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1. ) 
     111      CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1._wp )      ! local domain boundaries  (T-point, unchanged sign) 
     112      CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1._wp ) 
    113113      ! 
    114114#if defined key_obc  
    … …  
    124124      ! set time step size (Euler/Leapfrog) 
    125125      IF( neuler == 0 .AND. kt == nit000 ) THEN   ;   r2dtra(:) =     rdttra(:)      ! at nit000             (Euler) 
    126       ELSEIF( kt <= nit000 + 1 )           THEN   ;   r2dtra(:) = 2.* rdttra(:)      ! at nit000 or nit000+1 (Leapfrog) 
     126      ELSEIF( kt <= nit000 + 1 )           THEN   ;   r2dtra(:) = 2._wp* rdttra(:)      ! at nit000 or nit000+1 (Leapfrog) 
    127127      ENDIF 
    128128 
    … …  
    155155      IF( l_trdtra ) THEN      ! trend of the Asselin filter (tb filtered - tb)/dt      
    156156         DO jk = 1, jpkm1 
    157             zfact = 1.e0 / r2dtra(jk)              
     157            zfact = 1.e0_wp / r2dtra(jk)              
    158158            ztrdt(:,:,jk) = ( tsb(:,:,jk,jp_tem) - ztrdt(:,:,jk) ) * zfact 
    159159            ztrds(:,:,jk) = ( tsb(:,:,jk,jp_sal) - ztrds(:,:,jk) ) * zfact 

  • branches/2013/dev_CMCC_INGV_2013/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90

    r3680 r4201  
    338338      cn_dir = './'       ! directory in which the model is executed 
    339339      ! ... default values (NB: frequency positive => hours, negative => months) 
    340       !            !     file       ! frequency !  variable  ! time interp !  clim   ! 'yearly' or ! weights  ! rotation   ! 
    341       !            !     name       !  (hours)  !    name    !    (T/F)    !  (T/F)  ! 'monthly'   ! filename ! pairs      ! 
    342       sn_chl = FLD_N( 'chlorophyll' ,    -1     ,  'CHLA'    ,  .true.     , .true.  ,   'yearly'  , ''       , ''         ) 
     340      !            !     file       ! frequency !  variable  ! time interp !  clim   ! 'yearly' or ! weights  ! rotation   ! land/sea mask ! 
     341      !            !     name       !  (hours)  !    name    !    (T/F)    !  (T/F)  ! 'monthly'   ! filename ! pairs      ! filename      ! 
     342      sn_chl = FLD_N( 'chlorophyll' ,    -1     ,  'CHLA'    ,  .true.     , .true.  ,   'yearly'  , ''       , ''         , ''            ) 
    343343      ! 
    344344      REWIND( numnam )            ! Read Namelist namtra_qsr : ratio and length of penetration 

  • branches/2013/dev_CMCC_INGV_2013/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r3769 r4201  
    8484#endif 
    8585   USE sbctide, ONLY: lk_tide 
     86   USE lbcnfd, ONLY: isendto, nsndto ! Setup of north fold exchanges  
    8687 
    8788   IMPLICIT NONE 
    … …  
    683684      !!====================================================================== 
    684685      !!                     ***  ROUTINE  nemo_northcomms  *** 
    685       !! nemo_northcomms    :  Setup for north fold exchanges with explicit peer to peer messaging 
     686      !! nemo_northcomms    :  Setup for north fold exchanges with explicit  
     687      !!                       point-to-point messaging 
    686688      !!===================================================================== 
    687689      !!---------------------------------------------------------------------- 
    … …  
    690692      !!---------------------------------------------------------------------- 
    691693      !!    1.0  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE) 
    692       !!---------------------------------------------------------------------- 
    693  
    694       INTEGER ::   ji, jj, jk, ij, jtyp    ! dummy loop indices 
    695       INTEGER ::   ijpj                    ! number of rows involved in north-fold exchange 
    696       INTEGER ::   northcomms_alloc        ! allocate return status 
    697       REAL(wp), ALLOCATABLE, DIMENSION ( :,: ) ::   znnbrs     ! workspace 
    698       LOGICAL,  ALLOCATABLE, DIMENSION ( : )   ::   lrankset   ! workspace 
    699  
    700       IF(lwp) WRITE(numout,*) 
    701       IF(lwp) WRITE(numout,*) 'nemo_northcomms : Initialization of the northern neighbours lists' 
    702       IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 
    703  
    704       !!---------------------------------------------------------------------- 
    705       ALLOCATE( znnbrs(jpi,jpj), stat = northcomms_alloc ) 
    706       ALLOCATE( lrankset(jpnij), stat = northcomms_alloc ) 
    707       IF( northcomms_alloc /= 0 ) THEN 
    708          WRITE(numout,cform_war) 
    709          WRITE(numout,*) 'northcomms_alloc : failed to allocate arrays' 
    710          CALL ctl_stop( 'STOP', 'nemo_northcomms : unable to allocate temporary arrays' ) 
    711       ENDIF 
     694      !!    2.0  ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC)  
     695      !!---------------------------------------------------------------------- 
     696 
     697      INTEGER  ::   sxM, dxM, sxT, dxT, jn 
     698      INTEGER  ::   njmppmax 
     699 
     700      njmppmax = MAXVAL( njmppt ) 
     701     
     702      !initializes the north-fold communication variables 
     703      isendto(:) = 0 
    712704      nsndto = 0 
    713       isendto = -1 
    714       ijpj   = 4 
    715       ! 
    716       ! This routine has been called because ln_nnogather has been set true ( nammpp ) 
    717       ! However, these first few exchanges have to use the mpi_allgather method to 
    718       ! establish the neighbour lists to use in subsequent peer to peer exchanges. 
    719       ! Consequently, set l_north_nogather to be false here and set it true only after 
    720       ! the lists have been established. 
    721       ! 
    722       l_north_nogather = .FALSE. 
    723       ! 
    724       ! Exchange and store ranks on northern rows 
    725  
    726       DO jtyp = 1,4 
    727  
    728          lrankset = .FALSE. 
    729          znnbrs = narea 
    730          SELECT CASE (jtyp) 
    731             CASE(1) 
    732                CALL lbc_lnk( znnbrs, 'T', 1. )      ! Type 1: T,W-points 
    733             CASE(2) 
    734                CALL lbc_lnk( znnbrs, 'U', 1. )      ! Type 2: U-point 
    735             CASE(3) 
    736                CALL lbc_lnk( znnbrs, 'V', 1. )      ! Type 3: V-point 
    737             CASE(4) 
    738                CALL lbc_lnk( znnbrs, 'F', 1. )      ! Type 4: F-point 
    739          END SELECT 
    740  
    741          IF ( njmppt(narea) .EQ. MAXVAL( njmppt ) ) THEN 
    742             DO jj = nlcj-ijpj+1, nlcj 
    743                ij = jj - nlcj + ijpj 
    744                DO ji = 1,jpi 
    745                   IF ( INT(znnbrs(ji,jj)) .NE. 0 .AND. INT(znnbrs(ji,jj)) .NE. narea ) & 
    746                &     lrankset(INT(znnbrs(ji,jj))) = .true. 
    747                END DO 
    748             END DO 
    749  
    750             DO jj = 1,jpnij 
    751                IF ( lrankset(jj) ) THEN 
    752                   nsndto(jtyp) = nsndto(jtyp) + 1 
    753                   IF ( nsndto(jtyp) .GT. jpmaxngh ) THEN 
    754                      CALL ctl_stop( ' Too many neighbours in nemo_northcomms ', & 
    755                   &                 ' jpmaxngh will need to be increased ') 
    756                   ENDIF 
    757                   isendto(nsndto(jtyp),jtyp) = jj-1   ! narea converted to MPI rank 
    758                ENDIF 
    759             END DO 
    760          ENDIF 
    761  
    762       END DO 
    763  
    764       ! 
    765       ! Type 5: I-point 
    766       ! 
    767       ! ICE point exchanges may involve some averaging. The neighbours list is 
    768       ! built up using two exchanges to ensure that the whole stencil is covered. 
    769       ! lrankset should not be reset between these 'J' and 'K' point exchanges 
    770  
    771       jtyp = 5 
    772       lrankset = .FALSE. 
    773       znnbrs = narea 
    774       CALL lbc_lnk( znnbrs, 'J', 1. ) ! first ice U-V point 
    775  
    776       IF ( njmppt(narea) .EQ. MAXVAL( njmppt ) ) THEN 
    777          DO jj = nlcj-ijpj+1, nlcj 
    778             ij = jj - nlcj + ijpj 
    779             DO ji = 1,jpi 
    780                IF ( INT(znnbrs(ji,jj)) .NE. 0 .AND. INT(znnbrs(ji,jj)) .NE. narea ) & 
    781             &     lrankset(INT(znnbrs(ji,jj))) = .true. 
    782          END DO 
    783         END DO 
    784       ENDIF 
    785  
    786       znnbrs = narea 
    787       CALL lbc_lnk( znnbrs, 'K', 1. ) ! second ice U-V point 
    788  
    789       IF ( njmppt(narea) .EQ. MAXVAL( njmppt )) THEN 
    790          DO jj = nlcj-ijpj+1, nlcj 
    791             ij = jj - nlcj + ijpj 
    792             DO ji = 1,jpi 
    793                IF ( INT(znnbrs(ji,jj)) .NE. 0 .AND.  INT(znnbrs(ji,jj)) .NE. narea ) & 
    794             &       lrankset( INT(znnbrs(ji,jj))) = .true. 
    795             END DO 
    796          END DO 
    797  
    798          DO jj = 1,jpnij 
    799             IF ( lrankset(jj) ) THEN 
    800                nsndto(jtyp) = nsndto(jtyp) + 1 
    801                IF ( nsndto(jtyp) .GT. jpmaxngh ) THEN 
    802                   CALL ctl_stop( ' Too many neighbours in nemo_northcomms ', & 
    803                &                 ' jpmaxngh will need to be increased ') 
    804                ENDIF 
    805                isendto(nsndto(jtyp),jtyp) = jj-1   ! narea converted to MPI rank 
    806             ENDIF 
    807          END DO 
    808          ! 
    809          ! For northern row areas, set l_north_nogather so that all subsequent exchanges 
    810          ! can use peer to peer communications at the north fold 
    811          ! 
    812          l_north_nogather = .TRUE. 
    813          ! 
    814       ENDIF 
    815       DEALLOCATE( znnbrs ) 
    816       DEALLOCATE( lrankset ) 
    817  
     705 
     706      !if I am a process in the north 
     707      IF ( njmpp == njmppmax ) THEN 
     708          !sxM is the first point (in the global domain) needed to compute the 
     709          !north-fold for the current process 
     710          sxM = jpiglo - nimppt(narea) - nlcit(narea) + 1 
     711          !dxM is the last point (in the global domain) needed to compute the 
     712          !north-fold for the current process 
     713          dxM = jpiglo - nimppt(narea) + 2 
     714 
     715          !loop over the other north-fold processes to find the processes 
     716          !managing the points belonging to the sxT-dxT range 
     717          DO jn = jpnij - jpni +1, jpnij 
     718             IF ( njmppt(jn) == njmppmax ) THEN 
     719                !sxT is the first point (in the global domain) of the jn 
     720                !process 
     721                sxT = nimppt(jn) 
     722                !dxT is the last point (in the global domain) of the jn 
     723                !process 
     724                dxT = nimppt(jn) + nlcit(jn) - 1 
     725                IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN 
     726                   nsndto = nsndto + 1 
     727                   isendto(nsndto) = jn 
     728                ELSEIF ((sxM .le. sxT) .AND. (dxM .gt. dxT)) THEN 
     729                   nsndto = nsndto + 1 
     730                   isendto(nsndto) = jn 
     731                ELSEIF ((dxM .lt. dxT) .AND. (sxT .lt. dxM)) THEN 
     732                   nsndto = nsndto + 1 
     733                   isendto(nsndto) = jn 
     734                END IF 
     735             END IF 
     736          END DO 
     737      ENDIF 
     738      l_north_nogather = .TRUE. 
    818739   END SUBROUTINE nemo_northcomms 
    819740#else 

  • branches/2013/dev_CMCC_INGV_2013/NEMOGCM/NEMO/OPA_SRC/step.F90

    r3985 r4201  
    183183                             tsa(:,:,:,:) = 0.e0            ! set tracer trends to zero 
    184184 
     185!write(numout,*) "MAV kt",kstp 
     186!write(numout,'(a5,3(1x,f21.18))') "INIn:",tsn(24,11,1,jp_tem),tsn(24,11,1,jp_sal),sshn(24,11) 
     187!write(numout,'(a5,3(1x,f21.18))') "INIa:",tsa(24,11,1,jp_tem),tsa(24,11,1,jp_sal),ssha(24,11) 
    185188      IF(  ln_asmiau .AND. & 
    186189         & ln_trainc     )   CALL tra_asm_inc( kstp )       ! apply tracer assimilation increment 
    … …  
    192195      IF( lk_bdy         )   CALL bdy_tra_dmp( kstp )       ! bdy damping trends 
    193196                             CALL tra_adv    ( kstp )       ! horizontal & vertical advection 
     197!write(numout,'(a5,3(1x,f21.18))') "ADVn:",tsn(24,11,1,jp_tem),tsn(24,11,1,jp_sal),sshn(24,11) 
     198!write(numout,'(a5,3(1x,f21.18))') "ADVa:",tsa(24,11,1,jp_tem),tsa(24,11,1,jp_sal),ssha(24,11) 
    194199      IF( lk_zdfkpp      )   CALL tra_kpp    ( kstp )       ! KPP non-local tracer fluxes 
    195200                             CALL tra_ldf    ( kstp )       ! lateral mixing 
     201!write(numout,'(a5,3(1x,f21.18))') "LDFn:",tsn(24,11,1,jp_tem),tsn(24,11,1,jp_sal),sshn(24,11) 
     202!write(numout,'(a5,3(1x,f21.18))') "LDFa:",tsa(24,11,1,jp_tem),tsa(24,11,1,jp_sal),ssha(24,11) 
    196203#if defined key_agrif 
    197204      IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_tra          ! tracers sponge 
    198205#endif 
    199206                             CALL tra_zdf    ( kstp )       ! vertical mixing and after tracer fields 
     207!do jk=1,jpk 
     208!write(numout,'(a5,3(1x,f21.18))') "ZDFn:",tsn(5,10,jk,jp_tem),tsn(5,10,jk,jp_sal),tmask(5,10,jk) 
     209!write(numout,'(a5,3(1x,f21.18))') "ZDFa:",tsa(5,10,jk,jp_tem),tsa(5,10,jk,jp_sal),ssha(5,10) 
     210!end do 
    200211 
    201212      IF( ln_dynhpg_imp  ) THEN                             ! semi-implicit hpg (time stepping then eos) 
    … …  
    210221         IF( ln_zps      )   CALL zps_hde( kstp, jpts, tsn, gtsu, gtsv,  &    ! zps: now hor. derivative 
    211222            &                                          rhd, gru , grv  )      ! of t, s, rd at the last ocean level 
     223!write(numout,'(a5,3(1x,f21.18))') "ZPSn:",tsn(24,11,1,jp_tem),tsn(24,11,1,jp_sal),sshn(24,11) 
     224!write(numout,'(a5,3(1x,f21.18))') "ZPSa:",tsa(24,11,1,jp_tem),tsa(24,11,1,jp_sal),ssha(24,11) 
    212225         IF( ln_zdfnpc   )   CALL tra_npc( kstp )                ! update after fields by non-penetrative convection 
    213226                             CALL tra_nxt( kstp )                ! tracer fields at next time step 
     227!write(numout,'(a5,3(1x,f21.18))') "NXTn:",tsn(24,11,1,jp_tem),tsn(24,11,1,jp_sal),sshn(25,11) 
     228!write(numout,'(a5,3(1x,f21.18))') "NXTa:",tsa(24,11,1,jp_tem),tsa(24,11,1,jp_sal),ssha(24,11) 
    214229      ENDIF 
    215230 
Note: See TracChangeset for help on using the changeset viewer.