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 4230 for branches/2013/dev_LOCEAN_CMCC_INGV_2013/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90 – NEMO

Ignore:
Timestamp:
2013-11-18T12:57:11+01:00 (10 years ago)
Author:
cetlod
Message:

dev_LOCEAN_CMCC_INGV_2013 : merge LOCEAN & CMCC_INGV branches, see ticket #1182

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2013/dev_LOCEAN_CMCC_INGV_2013/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90

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