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

Changeset 10210


Ignore:
Timestamp:
2018-10-22T16:19:11+02:00 (5 years ago)
Author:
cbricaud
Message:

modifications for limited area configuration

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2018/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsdom.F90

    r10171 r10210  
    7373            ijje = mje_crs(jj) 
    7474 
     75            IF( ijis .le. 0   )WRITE(narea+1000-1,*)"BUG ijis ";CALL FLUSH(narea+1000-1) 
     76            IF( ijie .gt. jpi )WRITE(narea+1000-1,*)"BUG ijie ";CALL FLUSH(narea+1000-1) 
     77            IF( ijjs .le. 0   )WRITE(narea+1000-1,*)"BUG ijjs ";CALL FLUSH(narea+1000-1) 
     78            IF( ijje .gt. jpj )WRITE(narea+1000-1,*)"BUG ijje ";CALL FLUSH(narea+1000-1) 
     79 
     80            !IF( jj==nlej_crs .OR. ji==nlei_crs )THEN 
     81            !WRITE(narea+1000-1,*)"MASK A",ji,jj 
     82            !WRITE(narea+1000-1,*)"MASK A",ji+nimpp_crs-1,jj+njmpp_crs-1 
     83            !WRITE(narea+1000-1,*)"MASK B",ijis,ijie,ijjs,ijje 
     84            !WRITE(narea+1000-1,*)"MASK B",ijis+nimpp-1,ijie+nimpp-1,ijjs+njmpp-1,ijje+njmpp-1 
     85            !WRITE(narea+1000-1,*)"MASK C",SUM( tmask(ijis:ijie,ijjs:ijje,jk) ) 
     86            !ENDIF 
     87 
    7588            zmask = 0.0 
    7689            zmask = SUM( tmask(ijis:ijie,ijjs:ijje,jk) ) 
     
    95108   CALL crs_lbc_lnk( umask_crs, 'U', 1.0 ) 
    96109   CALL crs_lbc_lnk( fmask_crs, 'F', 1.0 ) 
     110 
    97111   ! 
    98112   END SUBROUTINE crs_dom_msk 
     
    216230   
    217231      !!----------------------------------------------------------------   
     232      p_e1_crs(:,:)=0._wp 
     233      p_e2_crs(:,:)=0._wp 
     234 
    218235      ! Initialize       
    219236 
     
    11181135      SELECT CASE ( jperio ) 
    11191136 
    1120       CASE ( 0, 1 ) 
    1121       jpiglo_crs   = INT( (jpiglo - 2) / nn_factx ) + 2 
    1122       jpjglo_crs   = INT( (jpjglo - 2) / nn_facty ) + 2 
    1123  
    1124       CASE ( 3, 4 )    !   
     1137      CASE ( 0, 1 )   ! limited area 
     1138 
     1139              !--!--!--!--!--!--!--!--!--! 
     1140              !        !        !        ! 
     1141              !        !        !        ! 
     1142              !        !        !        ! 
     1143              !--!--!--!--!--!--!--!--!--! 
     1144      !IBI36               1  2  3  4  5   
     1145      !IBI12  !    1   !   2    !   3    !     
     1146 
     1147 
     1148      jpiglo_crs   = INT( (jpiglo - 4) / nn_factx ) + 4 
     1149      jpjglo_crs   = INT( (jpjglo - 4) / nn_facty ) + 4 
     1150 
     1151      CASE ( 3, 4 )    ! global  
    11251152      jpiglo_crs   = INT( (jpiglo - 2) / nn_factx ) + 2 
    11261153      jpjglo_crs   = INT( (jpjglo - MOD(jpjglo, nn_facty)) / nn_facty ) + 2 
     
    11831210         ! check 
    11841211         !========================================================================== 
    1185          !CALL FLUSH(narea+1000-1) 
    11861212         !WRITE(narea+1000-1,*)"nfipproc(ji,jj),narea :",nfipproc(iproci,iprocj),narea 
    11871213         !WRITE(narea+1000-1,*)"proc i,j ",iproci,iprocj 
     
    12331259 
    12341260            DO ji=1,jpiglo_crs 
    1235                ijis=nn_factx*(ji-1)+1 
    1236                ijie=nn_factx*(ji-1)+3 
     1261               ijis=nn_factx*ji-6 
     1262               ijie=nn_factx*ji-4 
    12371263               mis2_crs(ji)=ijis 
    12381264               mie2_crs(ji)=ijie 
     1265               !WRITE(narea+1000-1,*)"glo crs",ji,ijis,ijie,ijis-nimpp+1,ijie-nimpp+1 
    12391266            ENDDO 
    12401267 
     
    12711298 
    12721299         !---------------------------------------------------------------------------------------------- 
    1273          ! I-3 compute nldi_crs and compute mis2_crs and mie2_crs for the first cell of the local domain  
     1300         ! I-3 compute nldi_crs  
     1301         !     special case  when the domain on the left is land:  
     1302         !         compute mis2_crs and mie2_crs for the first cell of the local domain  
    12741303         !--------------------------------------------------------------------------------------------- 
    12751304         nldi_crs = 2 
    1276          IF( nowe == -1 .AND. ( (jperio==3 .OR. jperio==4 ) .OR. ( (jperio==0 .OR. jperio==1 ) .AND. iproci .NE. 1 )) )THEN 
     1305         IF( nowe == -1 .AND. ( jperio==3 .OR. jperio==4 .OR. jperio==0 .OR. jperio==1 ) )THEN 
    12771306 
    12781307            mie2_crs(ijis-1) = mis2_crs(ijis)-1 
     
    12811310               CASE(1) 
    12821311                  nldi_crs=2 
    1283                   mie2_crs(ijis-1) = -1 
    1284                   mis2_crs(ijis-1) = -1 
     1312                  mie2_crs(ijis-1) = 1 
     1313                  mis2_crs(ijis-1) = 1 
    12851314               CASE(2) 
    12861315                  nldi_crs=2 
     
    12891318                  nldi_crs=2 
    12901319                  mis2_crs(ijis-1) = mie2_crs(ijis-1) -1 
    1291                CASE DEFAULT 
    1292                   WRITE(narea+8000-1,*)"WRONG VALUE FOR iistart ",ii_start 
    12931320            END SELECT 
    12941321 
    12951322         ENDIF 
    1296  
     1323          
    12971324         !---------------------------------------------------------------------------------------------- 
    12981325         ! I-4 compute nimpp_crs 
     
    13001327         nimpp_crs = ijis-1 
    13011328         IF( nimpp==1 )nimpp_crs=1 
     1329 
     1330         !WRITE(narea+1000-1,*)" nimpp_crs ",nimpp_crs 
    13021331 
    13031332         !------------------------------------------------------------------------------- 
     
    13171346         ! I-6 compute nlei_crs and nlci_crs  
    13181347         !------------------------------------------------------------------------------- 
    1319          nlei_crs=ijie-nimpp_crs+1 
    1320          !nlci_crs=nlei_crs ! cbr ???? +jpreci 
    1321          !IF( iproci == jpni ) THEN ; nlci_crs=nlei_crs ! cbr ???? +jpreci 
    1322          !ELSE                      ; nlci_crs=nlei_crs+1 
    1323          !ENDIF 
    1324          !cbr???? IF( iproci == jpni )nlei_crs=nlci_crs 
     1348         nlei_crs = ijie-nimpp_crs+1 
     1349         nlci_crs = nlei_crs+1 
    13251350 
    13261351         !------------------------------------------------------------------------------- 
     
    13401365         !--------------------------------------------------------------------------------------- 
    13411366         DO ji = 1, nlei_crs 
    1342             IF( mig_crs(ji) .GT. jpiglo_crs )WRITE(narea+1000-1,*)"BUG1 " ; CALL FLUSH(narea+1000-1) 
    13431367            mis_crs(ji) = mis2_crs(mig_crs(ji)) - nimpp + 1 
    13441368            mie_crs(ji) = mie2_crs(mig_crs(ji)) - nimpp + 1 
    1345             !IF( iproci == jpni  .AND. ji == nlei_crs )THEN 
    1346             !   mie_crs(ji) = nlei 
    1347             !   mie2_crs(mig_crs(ji)) = mig(nlei) 
    1348             !ENDIF 
    13491369            nfactx(ji)  = mie_crs(ji)-mis_crs(ji)+1 
    13501370         ENDDO 
    13511371 
    1352          !--------- 
    1353          !cbr  
     1372         !----------------------------------------------------------------------------- 
     1373         !adapt western indices for E-W BC ( jperio 3/4 ) or ghost cells ( jperio 0/1)  
     1374         !----------------------------------------------------------------------------- 
    13541375         IF( iproci == 1 ) THEN 
    1355             nldi_crs=1 
    1356             mis_crs(1) = 1 
    1357             mie_crs(1) = 1 
    1358             mis2_crs(1) = 1 
    1359             mie2_crs(1) = 1 
     1376 
     1377            SELECT CASE ( jperio ) 
     1378 
     1379            CASE ( 3, 4 ) 
     1380 
     1381               nldi_crs=1 
     1382               mis_crs(1)  = 1 
     1383               mie_crs(1)  = 1 
     1384               mis2_crs(1) = 1 
     1385               mie2_crs(1) = 1 
     1386 
     1387            CASE ( 0, 1 ) 
     1388               nldi_crs=1 
     1389               !the first cell is a ghsot cell; so set indices to 1 just to have an positive indice 
     1390               mis_crs(1)  = 1 
     1391               mie_crs(1)  = 1 
     1392               mis2_crs(1) = 1 
     1393               mie2_crs(1) = 1 
     1394               nfactx(1)   = 1 
     1395 
     1396               !the second coarsened cell correspond to the first (ghost) and second cell of HR grid 
     1397               mis_crs(2)  = 1 
     1398               mie_crs(2)  = 2 
     1399               mis2_crs(2) = 1 
     1400               mie2_crs(2) = 2 
     1401               nfactx(2)   = 2 
     1402 
     1403            CASE DEFAULT 
     1404               WRITE(numout,*) 'crs_init. Only jperio = 0, 1, 3, 4 supported; narea: ',narea 
     1405            END SELECT 
     1406         
    13601407         ENDIF 
    13611408 
    1362          IF( iproci == jpni ) THEN 
    1363             nlei_crs=jpiglo_crs-nimpp_crs+1 
    1364             nlci_crs=nlei_crs 
    1365             mis_crs(nlei_crs) = 1 
    1366             mie_crs(nlei_crs) = 1 
    1367             mis2_crs(nlei_crs) = 1 
    1368             mie2_crs(nlei_crs) = 1 
    1369             nfactx(nlei_crs)=0 
    1370          ELSE 
    1371             nlci_crs=nlei_crs+1 
    1372          ENDIF 
    1373  
     1409         !---------------------------------------------------------------------------- 
     1410         !adapt eastern indices for E-W BC ( jperio 3/4 ) or ghost cells ( jperio 0/1)  
     1411         !---------------------------------------------------------------------------- 
     1412         SELECT CASE ( jperio ) 
     1413 
     1414         CASE ( 3, 4 ) 
     1415 
     1416            IF( iproci == jpni ) THEN 
     1417               nlei_crs           = jpiglo_crs-nimpp_crs+1 
     1418               nlci_crs           = nlei_crs 
     1419               mis_crs(nlei_crs)  = 1 
     1420               mie_crs(nlei_crs)  = 1 
     1421               mis2_crs(nlei_crs) = 1 
     1422               mie2_crs(nlei_crs) = 1 
     1423               nfactx(nlei_crs)   = 0 
     1424            ENDIF 
     1425 
     1426         CASE ( 0, 1 ) 
     1427            IF( iproci == jpni ) THEN 
     1428 
     1429             !              |                 |                 |                 | 
     1430             !            __|_____!_____!_____|_____!_____!_____|_____!_____!_____| 
     1431             !HR    grid loc                         nlei 
     1432             !HR    grid glo                        jpiglo 
     1433             !HRCRS grid loc                      nlei_crs-1           nlei 
     1434             !HRCRS grid glo                      jpiglo-1            jpiglo 
     1435 
     1436 
     1437               !last cell ( = ghost cell) 
     1438               nlei_crs           = jpiglo_crs-nimpp_crs+1 
     1439               nlci_crs           = nlei_crs 
     1440      
     1441               mis2_crs(nlei_crs) = jpiglo 
     1442               mie2_crs(nlei_crs) = jpiglo 
     1443               mis_crs (nlei_crs) = jpiglo     - nimpp + 1 
     1444               mie_crs (nlei_crs) = jpiglo     - nimpp + 1 
     1445               nfactx  (nlei_crs) = 1 
     1446 
     1447               mis2_crs(nlei_crs-1) = jpiglo - 1 
     1448               mie2_crs(nlei_crs-1) = jpiglo 
     1449               mis_crs (nlei_crs-1) = jpiglo - 1 - nimpp + 1  
     1450               mie_crs (nlei_crs-1) = jpiglo     - nimpp + 1 
     1451               nfactx  (nlei_crs-1) = 2 
     1452 
     1453            ENDIF 
     1454         CASE DEFAULT 
     1455            WRITE(numout,*) 'crs_init. Only jperio = 0, 1, 3, 4 supported; narea: ',narea 
     1456         END SELECT 
     1457 
     1458          
    13741459         !WRITE(narea+1000-1,*)"loc crs jpi nldi,nlei,nlci ",jpi_crs, nldi_crs            ,nlei_crs             ,nlci_crs 
    13751460         !CALL FLUSH(narea+1000-1) 
     
    14081493 
    14091494            DO jj=1,jpjglo_crs 
    1410                ijjs=nn_facty*(jj-1)+1 
    1411                ijje=nn_facty*(jj-1)+3 
     1495               ijjs=nn_facty*jj-6 
     1496               ijje=nn_facty*jj-4 
    14121497               mjs2_crs(jj)=ijjs 
    14131498               mje2_crs(jj)=ijje 
     1499               !WRITE(narea+1000-1,*)"glo crs",jj,ijjs,ijje,ijjs-njmpp+1,ijje-njmpp+1 
    14141500            ENDDO 
    14151501 
     
    14211507               mjs2_crs(jj)=ijjs 
    14221508               mje2_crs(jj)=ijje 
     1509               !WRITE(narea+1000-1,*)"glo crs",jj,ijjs,ijje,ijjs-njmpp+1,ijje-njmpp+1 
    14231510            ENDDO 
    14241511 
     
    14441531 
    14451532         !---------------------------------------------------------------------------------------------- 
    1446          ! J-3 compute nldj_crs and compute mjs2_crs and mje2_crs for the first cell of the local domain  
     1533         ! J-3 compute nldj_crs  
     1534         !     global: special case when the domain on the north is land:  
     1535         !             compute mjs2_crs and mje2_crs for the first cell of the local domain  
     1536         !     local :  special case for southern domain  
    14471537         !--------------------------------------------------------------------------------------------- 
    14481538         nldj_crs = 2 
     
    14801570         njmpp_crs = ijjs-1 
    14811571         IF( njmpp==1 )njmpp_crs=1 
     1572         !WRITE(narea+1000-1,*)" njmpp_crs ",njmpp_crs 
    14821573 
    14831574         !------------------------------------------------------------------------------- 
     
    14991590         nlcj_crs=nlej_crs+jprecj 
    15001591 
     1592         !north-fold BC for global 
    15011593         IF( iprocj == jpnj )THEN 
    15021594            IF( jperio==3 .OR. jperio==4 )THEN 
    15031595               nlej_crs=nlej_crs+1 
    15041596               nlcj_crs=nlej_crs 
    1505             ELSE 
    1506                nlej_crs= nlej_crs+1 
    1507                nlcj_crs= nlcj_crs+1 
    15081597            ENDIF 
    15091598         ENDIF 
    15101599 
    1511          !WRITE(narea+1000-1,*)"loc crs jpj nldj,nlej,nlcj ",jpj_crs, nldj_crs            ,nlej_crs             ,nlcj_crs 
    1512          !CALL FLUSH(narea+1000-1) 
    1513          !WRITE(narea+1000-1,*)"glo crs jpj nldj,nlej      ",jpj_crs, nldj_crs+njmpp_crs-1,nlej_crs+njmpp_crs-1 
    1514          !CALL FLUSH(narea+1000-1) 
    15151600         !------------------------------------------------------------------------------- 
    15161601         ! J-7 local to global and global to local indices for CRS grid 
     
    15301615            mjs_crs(jj) = mjs2_crs(mjg_crs(jj)) - njmpp + 1 
    15311616            mje_crs(jj) = mje2_crs(mjg_crs(jj)) - njmpp + 1 
     1617            nfacty(jj)  = mje_crs(jj)-mjs_crs(jj)+1 
     1618            !WRITE(narea+1000-1,*)"test J",jj,mjg_crs(jj),mjs_crs(jj),mje_crs(jj),mjs_crs(jj)+njmpp-1,mje_crs(jj)+njmpp-1,nfacty(jj) 
     1619         ENDDO 
     1620 
     1621         !----------------------------------------------------------------------------- 
     1622         !adpat indices for southern side of the domain (ghost cells for jperio 0/1 )  
     1623         !----------------------------------------------------------------------------- 
     1624         IF( iprocj == 1 ) THEN 
     1625 
     1626            SELECT CASE ( jperio ) 
     1627 
     1628            CASE ( 3, 4 ) 
     1629               ! do nothing  
     1630            CASE ( 0, 1 ) 
     1631                nldj_crs = 1 
     1632               !the first cell is a ghsot cell; so set indices to 1 just to have an positive indice 
     1633               mjs_crs(1)  = 1 
     1634               mje_crs(1)  = 1 
     1635               mjs2_crs(1) = 1 
     1636               mje2_crs(1) = 1 
     1637               nfacty(1)   = 1 
     1638 
     1639               !the second coarsened cell correspond to the first (ghost) and second cell of HR grid 
     1640               mjs_crs(2)  = 1 
     1641               mje_crs(2)  = 2 
     1642               mjs2_crs(2) = 1 
     1643               mje2_crs(2) = 2 
     1644               nfacty(2)   = 2 
     1645 
     1646            CASE DEFAULT 
     1647               WRITE(numout,*) 'crs_init. Only jperio = 0, 1, 3, 4 supported; narea: ',narea 
     1648            END SELECT 
     1649 
     1650         ENDIF 
     1651 
     1652         !----------------------------------------------- 
     1653         !adapt northen indices for ghost cells ( jperio 0/1)  
     1654         !----------------------------------------------- 
     1655         SELECT CASE ( jperio ) 
     1656 
     1657         CASE ( 3, 4 ) 
    15321658            IF( iprocj == jpnj  .AND. jj == nlej_crs )THEN 
    15331659               mjs_crs(jj) = nlej 
     
    15361662               mje2_crs(mjg_crs(jj)) = mjg(nlej) 
    15371663            ENDIF 
    1538             nfacty(jj)  = mje_crs(jj)-mjs_crs(jj)+1 
    1539             !WRITE(narea+1000-1,*)"test J",jj,mjg_crs(jj),mjs_crs(jj),mje_crs(jj),mjs_crs(jj)+njmpp-1,mje_crs(jj)+njmpp-1,nfacty(jj) 
    1540          ENDDO 
     1664 
     1665         CASE ( 0, 1 ) 
     1666            IF( iprocj == jpnj ) THEN 
     1667               !north side of the domain 
     1668 
     1669               !last cell ( = ghost cell) 
     1670               nlej_crs           = jpjglo_crs-njmpp_crs+1 
     1671               nlcj_crs           = nlej_crs 
     1672 
     1673               mjs2_crs(nlej_crs) = jpjglo 
     1674               mje2_crs(nlej_crs) = jpjglo 
     1675               mjs_crs (nlej_crs) = jpjglo     - njmpp + 1 
     1676               mje_crs (nlej_crs) = jpjglo     - njmpp + 1 
     1677               nfacty  (nlej_crs) = 1 
     1678 
     1679               mjs2_crs(nlej_crs-1) = jpjglo - 1 
     1680               mje2_crs(nlej_crs-1) = jpjglo 
     1681               mjs_crs (nlej_crs-1) = jpjglo - 1 - njmpp + 1 
     1682               mje_crs (nlej_crs-1) = jpjglo     - njmpp + 1 
     1683               nfacty  (nlej_crs-1) = 2 
     1684 
     1685            ENDIF 
     1686         CASE DEFAULT 
     1687           WRITE(numout,*) 'crs_init. Only jperio = 0, 1, 3, 4 supported; narea: ',narea 
     1688         END SELECT 
    15411689 
    15421690         !WRITE(narea+1000-1,*)"loc crs jpj nldj,nlej,nlcj ",jpj_crs, nldj_crs ,nlej_crs,nlcj_crs ; CALL FLUSH(narea+1000-1) 
     
    17471895 
    17481896      !!---------------------------------------------------------------- 
     1897 
    17491898      mikt_crs(:,:)=1 
    17501899 
Note: See TracChangeset for help on using the changeset viewer.