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 7222 for branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM – NEMO

Ignore:
Timestamp:
2016-11-14T15:34:11+01:00 (7 years ago)
Author:
cbricaud
Message:

CRS branch: cleaning

Location:
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO
Files:
3 edited

Legend:

Unmodified
Added
Removed

  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsdom.F90

    r7217 r7222  
    179179      CALL crs_lbc_lnk( p_gphi_crs, cd_type, 1.0 ) 
    180180      CALL crs_lbc_lnk( p_glam_crs, cd_type, 1.0 ) 
    181           
    182 !cbr???      ! Fill up jrow=1 which is zeroed out or not handled by lbc_lnk and lbc_nfd 
    183 !      SELECT CASE ( cd_type ) 
    184 !         CASE ( 'T', 'V' ) 
    185 !            DO ji = 2, nlei_crs 
    186 !               ijis = mis_crs(ji) + mxbinctr  
    187 !               p_gphi_crs(ji,1) = p_gphi(ijis,1) 
    188 !               p_glam_crs(ji,1) = p_glam(ijis,1) 
    189 !            ENDDO 
    190 !         CASE ( 'U', 'F' ) 
    191 !            DO ji = 2, nlei_crs 
    192 !               ijis = mis_crs(ji)  
    193 !               p_gphi_crs(ji,1) = p_gphi(ijis,1) 
    194 !               p_glam_crs(ji,1) = p_glam(ijis,1) 
    195 !            ENDDO 
    196 !      END SELECT 
    197181      ! 
    198182   END SUBROUTINE crs_dom_coordinates 
    … …  
    245229               SELECT CASE ( cd_type ) 
    246230                   CASE ( 'T' ) 
    247                       !p_e1_crs(ji,jj) = SUM( p_e1(ijis:ijie     ,ijjs+1       ) ) 
    248                       !p_e2_crs(ji,jj) = SUM( p_e2(ijis+1        ,ijjs:ijje    ) ) 
    249231                      p_e1_crs(ji,jj) = REAL(nn_factx,wp)*p_e1(ijis+1,ijjs+1) 
    250232                      p_e2_crs(ji,jj) = REAL(nn_facty,wp)*p_e2(ijis+1,ijjs+1) 
    251233                   CASE ( 'U' ) 
    252                       !p_e1_crs(ji,jj) = SUM( p_e1(ijis+1:ijie+1 ,ijjs+1       ) ) 
    253                       !p_e2_crs(ji,jj) = SUM( p_e2(ijie          ,ijjs:ijje    ) ) 
    254234                      p_e1_crs(ji,jj) = REAL(nn_factx,wp)*p_e1(ijis+1,ijjs+1       )  
    255235                      p_e2_crs(ji,jj) = REAL(nn_facty,wp)*p_e2(ijie  ,ijjs+1       )  
    256236 
    257237                   CASE ( 'V' ) 
    258                       !p_e1_crs(ji,jj) = SUM( p_e1(ijis:ijie     ,ijje         ) ) 
    259                       !p_e2_crs(ji,jj) = SUM( p_e2(ijis+1        ,ijjs+1:ijje+1) ) 
    260238                      p_e1_crs(ji,jj) = REAL(nn_factx,wp)*p_e1(ijis+1,ijje       )  
    261239                      p_e2_crs(ji,jj) = REAL(nn_facty,wp)*p_e2(ijis+1,ijjs+1     )  
    262240                   CASE ( 'F' ) 
    263                       !p_e1_crs(ji,jj) = SUM( p_e1(ijis+1:ijie+1 ,ijje         ) ) 
    264                       !p_e2_crs(ji,jj) = SUM( p_e2(ijie          ,ijjs+1:ijje+1) ) 
    265241                      p_e1_crs(ji,jj) = REAL(nn_factx,wp)*p_e1(ijis+1,ijje       )  
    266242                      p_e2_crs(ji,jj) = REAL(nn_facty,wp)*p_e2(ijie  ,ijjs+1     )  
    … …  
    270246 
    271247 
    272       CALL crs_lbc_lnk( p_e1_crs, cd_type, 1.0 ) !cbr , pval=1.0 ) 
    273       CALL crs_lbc_lnk( p_e2_crs, cd_type, 1.0 ) !cbr , pval=1.0 ) 
     248      CALL crs_lbc_lnk( p_e1_crs, cd_type, 1.0 ) 
     249      CALL crs_lbc_lnk( p_e2_crs, cd_type, 1.0 ) 
    274250 
    275251   END SUBROUTINE crs_dom_hgr 
    … …  
    11191095      !!               3) Define the processor domain indice for a croasening grid 
    11201096      !!---------------------------------------------------------------- 
    1121       !!  
    1122       !!  local variables 
    1123     
    1124       INTEGER  :: ji,jj,jk,ijjgloT,ijis,ijie,ijjs,ijje,jn      ! dummy indices 
    1125       INTEGER  :: ierr                                ! allocation error status 
     1097      INTEGER :: ji,jj,jk,ijjgloT,ijis,ijie,ijjs,ijje,jn      ! dummy indices 
     1098      INTEGER :: ierr                                ! allocation error status 
    11261099      INTEGER :: iproci,iprocj,iproc,iprocno,iprocso,iimppt_crs 
    11271100      INTEGER :: ii_start,ii_end,ij_start,ij_end 
     1101      !!---------------------------------------------------------------- 
    11281102  
    11291103   
    1130      ! 1.a. Define global domain indices  : take into account the interior domain only ( removes i/j=1 , i/j=jpiglo/jpjglo ) then add 2/3 grid points  
     1104      !============================================================================================== 
     1105      ! Define global and local domain sizes 
     1106      !============================================================================================== 
    11311107      jpiglo_crs   = INT( (jpiglo - 2) / nn_factx ) + 2 
    1132   !    jpjglo_crs   = INT( (jpjglo - 2) / nn_facty ) + 2  ! the -2 removes j=1, j=jpj 
    1133   !    jpjglo_crs   = INT( (jpjglo - 2) / nn_facty ) + 3 
    11341108      jpjglo_crs   = INT( (jpjglo - MOD(jpjglo, nn_facty)) / nn_facty ) + 2 
    11351109      jpiglo_crsm1 = jpiglo_crs - 1 
    … …  
    11381112      jpi_crs = ( jpiglo_crs   - 2 * jpreci + (jpni-1) ) / jpni + 2 * jpreci 
    11391113      jpj_crs = ( jpjglo_crsm1 - 2 * jprecj + (jpnj-1) ) / jpnj + 2 * jprecj 
    1140 !cbr?      IF( njmpp==1 )THEN 
    1141 !         jpj_crs=jpj_crs+1 
    1142 !      ENDIF 
    1143  
    11441114        
    11451115      jpi_crsm1   = jpi_crs - 1 
    11461116      jpj_crsm1   = jpj_crs - 1 
     1117 
    11471118      nperio_crs  = jperio 
    11481119      npolj_crs   = npolj 
    … …  
    11501121      ierr = crs_dom_alloc()          ! allocate most coarse grid arrays 
    11511122 
    1152       ! 2.a Define processor domain 
     1123      !============================================================================================== 
     1124      ! Define processor domain indices 
     1125      !============================================================================================== 
    11531126      IF( .NOT. lk_mpp ) THEN 
     1127 
    11541128         nimpp_crs  = 1 
    11551129         njmpp_crs  = 1 
    … …  
    11601134         nlei_crs   = jpi_crs 
    11611135         nlej_crs   = jpj_crs 
     1136 
    11621137      ELSE 
    1163          ! Initialisation of most local variables - 
     1138 
    11641139         nimpp_crs  = 1 
    11651140         njmpp_crs  = 1 
    … …  
    11711146         nlej_crs   = jpj_crs 
    11721147 
    1173         !============================================================================================== 
    1174         ! mpp_ini2 
    1175         !============================================================================================== 
    1176         DO ji = 1 , jpni 
    1177            DO jj = 1 ,jpnj 
    1178               IF( nfipproc(ji,jj)  == narea-1 )THEN 
    1179                  iproci=ji 
    1180                  iprocj=jj 
    1181               ENDIF 
    1182            ENDDO 
    1183         ENDDO 
    1184  
    1185         !WRITE(narea+8000-1,*)"nfipproc(ji,jj),narea :",nfipproc(iproci,iprocj),narea 
    1186         !WRITE(narea+8000-1,*)"proc i,j ",iproci,iprocj 
    1187         !WRITE(narea+8000-1,*)"nowe noea",nowe,noea 
    1188         !WRITE(narea+8000-1,*)"noso nono",noso,nono 
    1189         !WRITE(narea+8000-1,*)"nbondi nbondj ",nbondi,nbondj 
    1190         !WRITE(narea+8000-1,*)"jpiglo jpjglo ",jpiglo,jpjglo 
    1191         !WRITE(narea+8000-1,*)"jpi jpj ",jpi,jpj 
    1192         !WRITE(narea+8000-1,*)"nbondi nbondj",nbondi,nbondj 
    1193         !WRITE(narea+8000-1,*)"nimpp njmpp ",nimpp,njmpp 
    1194         !WRITE(narea+8000-1,*)"loc jpi nldi,nlei,nlci ",jpi, nldi        ,nlei         ,nlci 
    1195         !WRITE(narea+8000-1,*)"glo jpi nldi,nlei      ",jpi, nldi+nimpp-1,nlei+nimpp-1 
    1196         !WRITE(narea+8000-1,*)"loc jpj nldj,nlej,nlcj ",jpj, nldj        ,nlej         ,nlcj 
    1197         !WRITE(narea+8000-1,*)"glo jpj nldj,nlej      ",jpj, nldj+njmpp-1,nlej+njmpp-1 
    1198         !WRITE(narea+8000-1,*)"jpiglo_crs jpjglo_crs ",jpiglo_crs,jpjglo_crs 
    1199         !WRITE(narea+8000-1,*)"jpi_crs jpj_crs ",jpi_crs,jpj_crs 
    1200         !WRITE(narea+8000-1,*)"jpni  jpnj jpnij ",jpni,jpnj,jpnij 
    1201         !WRITE(narea+8000-1,*)"glamt gphit ",glamt(1,1),gphit(jpi,jpj),glamt(jpi,jpj),gphit(jpi,jpj) 
    1202         !========================================================================== 
    1203         ! dim along I 
    1204         !========================================================================== 
    1205         SELECT CASE ( nperio ) 
    1206         CASE ( 0, 1, 3, 4 )    !   3, 4 : T-Pivot at North Fold 
    1207  
    1208            DO ji=1,jpiglo_crs 
    1209               ijis=nn_factx*(ji-1)-2 
    1210               ijie=nn_factx*(ji-1) 
    1211               mis2_crs(ji)=ijis 
    1212               mie2_crs(ji)=ijie 
    1213            ENDDO 
    1214  
    1215            ji=1 
    1216            DO WHILE( mis2_crs(ji) - nimpp + 1 .LT. 1 )  
    1217               ji=ji+1 
    1218               IF( ji==jpiglo_crs )EXIT 
    1219            END DO 
    1220            ijis=ji 
    1221  
    1222            !mjs2_crs(ijis)=indice global ds la grille no crs de la premiere maille du premier pavé contenu ds le domaine intérieur 
    1223            !ijis          =indice global ds la grille    crs de la premire maille qui est ds le domaine intérieur 
    1224            !ii_start      =indice local de mjs2_crs(jj) 
    1225            ii_start = mis2_crs(ijis)-nimpp+1 
    1226            nimpp_crs = ijis-1 
    1227  
    1228            nldi_crs = 2 
    1229            IF( nowe == -1 )THEN 
     1148         !============================================================================================== 
     1149         ! mpp_ini2 
     1150         !============================================================================================== 
     1151 
     1152         !order of local domain in i and j directions 
     1153         DO ji = 1 , jpni 
     1154            DO jj = 1 ,jpnj 
     1155               IF( nfipproc(ji,jj)  == narea-1 )THEN 
     1156                  iproci=ji 
     1157                  iprocj=jj 
     1158               ENDIF 
     1159            ENDDO 
     1160         ENDDO 
     1161 
     1162         !WRITE(narea+8000-1,*)"nfipproc(ji,jj),narea :",nfipproc(iproci,iprocj),narea 
     1163         !WRITE(narea+8000-1,*)"proc i,j ",iproci,iprocj 
     1164         !WRITE(narea+8000-1,*)"nowe noea",nowe,noea 
     1165         !WRITE(narea+8000-1,*)"noso nono",noso,nono 
     1166         !WRITE(narea+8000-1,*)"nbondi nbondj ",nbondi,nbondj 
     1167         !WRITE(narea+8000-1,*)"jpiglo jpjglo ",jpiglo,jpjglo 
     1168         !WRITE(narea+8000-1,*)"jpi jpj ",jpi,jpj 
     1169         !WRITE(narea+8000-1,*)"nbondi nbondj",nbondi,nbondj 
     1170         !WRITE(narea+8000-1,*)"nimpp njmpp ",nimpp,njmpp 
     1171         !WRITE(narea+8000-1,*)"loc jpi nldi,nlei,nlci ",jpi, nldi        ,nlei         ,nlci 
     1172         !WRITE(narea+8000-1,*)"glo jpi nldi,nlei      ",jpi, nldi+nimpp-1,nlei+nimpp-1 
     1173         !WRITE(narea+8000-1,*)"loc jpj nldj,nlej,nlcj ",jpj, nldj        ,nlej         ,nlcj 
     1174         !WRITE(narea+8000-1,*)"glo jpj nldj,nlej      ",jpj, nldj+njmpp-1,nlej+njmpp-1 
     1175         !WRITE(narea+8000-1,*)"jpiglo_crs jpjglo_crs ",jpiglo_crs,jpjglo_crs 
     1176         !WRITE(narea+8000-1,*)"jpi_crs jpj_crs ",jpi_crs,jpj_crs 
     1177         !WRITE(narea+8000-1,*)"jpni  jpnj jpnij ",jpni,jpnj,jpnij 
     1178         !WRITE(narea+8000-1,*)"glamt gphit ",glamt(1,1),gphit(jpi,jpj),glamt(jpi,jpj),gphit(jpi,jpj) 
     1179 
     1180         !========================================================================== 
     1181         ! coarsened domain: dimensions along I 
     1182         !========================================================================== 
     1183 
     1184         SELECT CASE ( nperio ) 
     1185   
     1186         CASE ( 0, 1, 3, 4 )    !   3, 4 : T-Pivot at North Fold 
     1187 
     1188            DO ji=1,jpiglo_crs 
     1189               ijis=nn_factx*(ji-1)-2 
     1190               ijie=nn_factx*(ji-1) 
     1191               mis2_crs(ji)=ijis 
     1192               mie2_crs(ji)=ijie 
     1193            ENDDO 
     1194 
     1195            ji=1 
     1196            DO WHILE( mis2_crs(ji) - nimpp + 1 .LT. 1 )  
     1197               ji=ji+1 
     1198               IF( ji==jpiglo_crs )EXIT 
     1199            END DO 
     1200            ijis=ji 
     1201 
     1202            !mjs2_crs(ijis)=indice global ds la grille no crs de la premiere maille du premier pavé contenu ds le domaine intérieur 
     1203            !ijis          =indice global ds la grille    crs de la premire maille qui est ds le domaine intérieur 
     1204            !ii_start      =indice local de mjs2_crs(jj) 
     1205            ii_start = mis2_crs(ijis)-nimpp+1 
     1206            nimpp_crs = ijis-1 
     1207 
     1208            nldi_crs = 2 
     1209            IF( nowe == -1 )THEN 
    12301210 
    12311211               mie2_crs(ijis-1) = mis2_crs(ijis)-1 
    … …  
    12371217                     mis2_crs(ijis-1) = -1 
    12381218                  CASE(2) 
    1239 !CBR?                     nldi_crs=1 
    12401219                     nldi_crs=2 
    12411220                     mis2_crs(ijis-1) = mie2_crs(ijis-1) 
    12421221                  CASE(3) 
    1243 !CBR?                     nldi_crs=1 
    12441222                     nldi_crs=2 
    12451223                     mis2_crs(ijis-1) = mie2_crs(ijis-1) -1 
    … …  
    12481226               END SELECT 
    12491227 
    1250            ENDIF 
    1251  
    1252            IF( nimpp==1 )nimpp_crs=1 
    1253  
    1254            !---------------------------------------- 
    1255            ji=jpiglo_crs 
    1256            DO WHILE( mie2_crs(ji) - nimpp + 1 .GT. jpi ) 
    1257               ji=ji-1 
    1258               IF( ji==1 )EXIT 
    1259            END DO 
    1260            ijie=ji 
    1261            nlei_crs=ijie-nimpp_crs+1 
    1262            nlci_crs=nlei_crs+jpreci 
    1263  
    1264            !---------------------------------------- 
    1265            DO ji = 1, jpi_crs 
    1266               mig_crs(ji) = ji + nimpp_crs - 1 
    1267            ENDDO 
    1268            DO ji = 1, jpiglo_crs 
    1269               mi0_crs(ji) = MAX( 1, MIN( ji - nimpp_crs + 1 , jpi_crs + 1 ) ) 
    1270               mi1_crs(ji) = MAX( 0, MIN( ji - nimpp_crs + 1 , jpi_crs     ) ) 
    1271            ENDDO 
    1272  
    1273            !---------------------------------------- 
    1274            DO ji = 1, nlei_crs 
    1275               mis_crs(ji) = mis2_crs(mig_crs(ji)) - nimpp + 1 
    1276               mie_crs(ji) = mie2_crs(mig_crs(ji)) - nimpp + 1 
    1277               nfactx(ji)  = mie_crs(ji)-mie_crs(ji)+1 
    1278            ENDDO 
    1279  
    1280            IF( iproci == jpni )THEN 
    1281               nlei_crs=nlci_crs 
    1282               mis_crs(nlei_crs)=mis_crs(nlei_crs-1) 
    1283               mie_crs(nlei_crs)=mie_crs(nlei_crs-1) 
    1284            ENDIF 
    1285  
    1286            !---------------------------------------- 
    1287  
    1288         CASE DEFAULT 
    1289            WRITE(numout,*) 'crs_init. Only jperio = 0, 1, 3, 4 supported' 
    1290         END SELECT 
    1291  
    1292         !========================================================================== 
    1293         ! dim along J 
    1294         !========================================================================== 
    1295         SELECT CASE ( nperio ) 
    1296         CASE ( 0, 1, 3, 4 )    !   3, 4 : T-Pivot at North Fold 
    1297  
    1298            DO jj=1,jpjglo_crs 
    1299               ijjs=nn_facty*(jj)-5 
    1300               ijje=nn_facty*(jj)-3 
    1301               mjs2_crs(jj)=ijjs 
    1302               mje2_crs(jj)=ijje 
    1303            ENDDO 
    1304  
    1305            jj=1 
    1306            DO WHILE( mjs2_crs(jj) - njmpp + 1 .LT. 1 ) 
    1307               jj=jj+1 
    1308               IF( jj==jpjglo_crs )EXIT 
    1309            END DO 
    1310            ijjs=jj 
    1311  
    1312            !mjs2_crs(jj)=indice global ds la grille no crs de la premiere maille du premier pavé contenu ds le domaine intérieur 
    1313            !ijjs        =indice global ds la grille    crs de la premire maille qui est ds le domaine intérieur 
    1314            !ij_start    =indice local de mjs2_crs(jj) 
    1315            ij_start = mjs2_crs(ijjs)-njmpp+1 
    1316            njmpp_crs = ijjs-1 
    1317  
    1318            nldj_crs = 2 
    1319            IF( noso == -1 )THEN 
     1228            ENDIF 
     1229 
     1230            IF( nimpp==1 )nimpp_crs=1 
     1231 
     1232            !---------------------------------------- 
     1233            ji=jpiglo_crs 
     1234            DO WHILE( mie2_crs(ji) - nimpp + 1 .GT. jpi ) 
     1235               ji=ji-1 
     1236               IF( ji==1 )EXIT 
     1237            END DO 
     1238            ijie=ji 
     1239            nlei_crs=ijie-nimpp_crs+1 
     1240            nlci_crs=nlei_crs+jpreci 
     1241 
     1242            !---------------------------------------- 
     1243            DO ji = 1, jpi_crs 
     1244               mig_crs(ji) = ji + nimpp_crs - 1 
     1245            ENDDO 
     1246            DO ji = 1, jpiglo_crs 
     1247               mi0_crs(ji) = MAX( 1, MIN( ji - nimpp_crs + 1 , jpi_crs + 1 ) ) 
     1248               mi1_crs(ji) = MAX( 0, MIN( ji - nimpp_crs + 1 , jpi_crs     ) ) 
     1249            ENDDO 
     1250 
     1251            !---------------------------------------- 
     1252            DO ji = 1, nlei_crs 
     1253               mis_crs(ji) = mis2_crs(mig_crs(ji)) - nimpp + 1 
     1254               mie_crs(ji) = mie2_crs(mig_crs(ji)) - nimpp + 1 
     1255               nfactx(ji)  = mie_crs(ji)-mie_crs(ji)+1 
     1256            ENDDO 
     1257 
     1258            IF( iproci == jpni )THEN 
     1259               nlei_crs=nlci_crs 
     1260               mis_crs(nlei_crs)=mis_crs(nlei_crs-1) 
     1261               mie_crs(nlei_crs)=mie_crs(nlei_crs-1) 
     1262            ENDIF 
     1263 
     1264            !---------------------------------------- 
     1265 
     1266         CASE DEFAULT 
     1267            WRITE(numout,*) 'crs_init. Only jperio = 0, 1, 3, 4 supported' 
     1268         END SELECT 
     1269 
     1270         !========================================================================== 
     1271         ! coarsened domain: dimensions along I 
     1272         !========================================================================== 
     1273         SELECT CASE ( nperio ) 
     1274         CASE ( 0, 1, 3, 4 )    !   3, 4 : T-Pivot at North Fold 
     1275 
     1276            DO jj=1,jpjglo_crs 
     1277               ijjs=nn_facty*(jj)-5 
     1278               ijje=nn_facty*(jj)-3 
     1279               mjs2_crs(jj)=ijjs 
     1280               mje2_crs(jj)=ijje 
     1281            ENDDO 
     1282 
     1283            jj=1 
     1284            DO WHILE( mjs2_crs(jj) - njmpp + 1 .LT. 1 ) 
     1285               jj=jj+1 
     1286               IF( jj==jpjglo_crs )EXIT 
     1287            END DO 
     1288            ijjs=jj 
     1289 
     1290            !mjs2_crs(jj)=indice global ds la grille no crs de la premiere maille du premier pavé contenu ds le domaine intérieur 
     1291            !ijjs        =indice global ds la grille    crs de la premire maille qui est ds le domaine intérieur 
     1292            !ij_start    =indice local de mjs2_crs(jj) 
     1293            ij_start = mjs2_crs(ijjs)-njmpp+1 
     1294            njmpp_crs = ijjs-1 
     1295 
     1296            nldj_crs = 2 
     1297            IF( noso == -1 )THEN 
    13201298 
    13211299               mje2_crs(ijjs-1) = mjs2_crs(ijjs)-1 
    … …  
    13271305                     mjs2_crs(ijjs-1) = -1 
    13281306                  CASE(2) 
    1329 !CBR?                     nldj_crs=1 
    13301307                     nldj_crs=2 
    13311308                     mjs2_crs(ijjs-1) = mje2_crs(ijjs-1) 
    13321309                  CASE(3) 
    1333 !CBR?                     nldj_crs=1 
    13341310                     nldj_crs=2 
    13351311                     mjs2_crs(ijjs-1) = mje2_crs(ijjs-1) -1 
    … …  
    13381314               END SELECT 
    13391315 
    1340            ENDIF 
    1341            IF( njmpp==1 )njmpp_crs=1 
    1342  
    1343  
    1344            !---------------------------------------- 
    1345            jj=jpjglo_crs 
    1346            DO WHILE( mje2_crs(jj) - njmpp + 1 .GT. nlcj ) 
    1347               jj=jj-1 
    1348               IF( jj==1 )EXIT 
    1349            END DO 
    1350            ijje=jj 
    1351  
    1352            nlej_crs=ijje-njmpp_crs+1 
    1353  
    1354            !---------------------------------------- 
    1355            nlcj_crs=nlej_crs+jprecj 
    1356            IF( iprocj == jpnj )THEN 
    1357               nlej_crs=jpj_crs ! cbr -1 ???????????????????? 
    1358               nlcj_crs=nlej_crs 
    1359            ENDIF 
     1316            ENDIF 
     1317            IF( njmpp==1 )njmpp_crs=1 
     1318 
     1319            !---------------------------------------- 
     1320            jj=jpjglo_crs 
     1321            DO WHILE( mje2_crs(jj) - njmpp + 1 .GT. nlcj ) 
     1322               jj=jj-1 
     1323               IF( jj==1 )EXIT 
     1324            END DO 
     1325            ijje=jj 
     1326 
     1327            nlej_crs=ijje-njmpp_crs+1 
     1328 
     1329            !---------------------------------------- 
     1330            nlcj_crs=nlej_crs+jprecj 
     1331            IF( iprocj == jpnj )THEN 
     1332               nlej_crs=jpj_crs 
     1333               nlcj_crs=nlej_crs 
     1334            ENDIF 
    13601335  
    1361            !---------------------------------------- 
    1362            DO jj = 1, jpj_crs 
    1363               mjg_crs(jj) = jj + njmpp_crs - 1 
    1364            ENDDO 
    1365            DO jj = 1, jpjglo_crs 
    1366               mj0_crs(jj) = MAX( 1, MIN( jj - njmpp_crs + 1 , jpj_crs + 1 ) ) 
    1367               mj1_crs(jj) = MAX( 0, MIN( jj - njmpp_crs + 1 , jpj_crs     ) ) 
    1368            ENDDO 
    1369  
    1370            !---------------------------------------- 
    1371            DO jj = 1, nlej_crs 
    1372               mjs_crs(jj) = mjs2_crs(mjg_crs(jj)) - njmpp + 1 
    1373               mje_crs(jj) = mje2_crs(mjg_crs(jj)) - njmpp + 1 
    1374               nfacty(jj)   = mje_crs(jj)-mje_crs(jj)+1 
    1375            ENDDO 
    1376  
    1377            IF( iprocj == jpnj )THEN 
    1378               mjs_crs(nlej_crs)=mjs_crs(nlej_crs-1) 
    1379               mje_crs(nlej_crs)=mje_crs(nlej_crs-1) 
    1380            ENDIF 
    1381  
    1382            !---------------------------------------- 
    1383  
    1384         CASE DEFAULT 
    1385            WRITE(numout,*) 'crs_init. Only jperio = 0, 1, 3, 4 supported' 
    1386         END SELECT 
    1387  
    1388         !========================================================================== 
    1389         IF( nlci_crs .GT. jpi_crs .OR. nlei_crs .GT. jpi_crs )WRITE(narea+8000-1,*)"BUGDIM ",nlei_crs,nlci_crs,jpi_crs; CALL FLUSH(narea+8000-1) 
    1390         IF( nlcj_crs .GT. jpj_crs .OR. nlej_crs .GT. jpj_crs )WRITE(narea+8000-1,*)"BUGDIM ",nlej_crs,nlcj_crs,jpj_crs; CALL FLUSH(narea+8000-1) 
    1391         !========================================================================== 
    1392  
    1393         nldit_crs(:)=0 ; nleit_crs(:)=0 ; nlcit_crs(:)=0 ; nimppt_crs(:)=0 
    1394         nldjt_crs(:)=0 ; nlejt_crs(:)=0 ; nlcjt_crs(:)=0 ; njmppt_crs(:)=0 
    1395  
    1396         CALL mppgatheri((/nlci_crs/),0,nlcit_crs) ; CALL mppgatheri((/nlcj_crs/),0,nlcjt_crs)  
    1397         CALL mppgatheri((/nldi_crs/),0,nldit_crs) ; CALL mppgatheri((/nldj_crs/),0,nldjt_crs)  
    1398         CALL mppgatheri((/nlei_crs/),0,nleit_crs) ; CALL mppgatheri((/nlej_crs/),0,nlejt_crs)  
    1399         CALL mppgatheri((/nimpp_crs/),0,nimppt_crs) ; CALL mppgatheri((/njmpp_crs/),0,njmppt_crs)  
    1400  
    1401         DO jj = 1 ,jpnj 
    1402            DO ji = 1 , jpni 
    1403               jn=nfipproc(ji,jj)+1 
    1404               IF( jn .GE. 1 )THEN 
    1405                  nfiimpp_crs(ji,jj)=nimppt_crs(jn) 
    1406               ELSE 
    1407                  nfiimpp_crs(ji,jj) = ANINT( REAL( (nfiimpp(ji,jj) + 1 ) / nn_factx, wp ) ) + 1 
    1408               ENDIF 
    1409            ENDDO 
    1410         ENDDO 
     1336            !---------------------------------------- 
     1337            DO jj = 1, jpj_crs 
     1338               mjg_crs(jj) = jj + njmpp_crs - 1 
     1339            ENDDO 
     1340            DO jj = 1, jpjglo_crs 
     1341               mj0_crs(jj) = MAX( 1, MIN( jj - njmpp_crs + 1 , jpj_crs + 1 ) ) 
     1342               mj1_crs(jj) = MAX( 0, MIN( jj - njmpp_crs + 1 , jpj_crs     ) ) 
     1343            ENDDO 
     1344 
     1345            !---------------------------------------- 
     1346            DO jj = 1, nlej_crs 
     1347               mjs_crs(jj) = mjs2_crs(mjg_crs(jj)) - njmpp + 1 
     1348               mje_crs(jj) = mje2_crs(mjg_crs(jj)) - njmpp + 1 
     1349               nfacty(jj)   = mje_crs(jj)-mje_crs(jj)+1 
     1350            ENDDO 
     1351 
     1352            IF( iprocj == jpnj )THEN 
     1353               mjs_crs(nlej_crs)=mjs_crs(nlej_crs-1) 
     1354               mje_crs(nlej_crs)=mje_crs(nlej_crs-1) 
     1355            ENDIF 
     1356 
     1357            !---------------------------------------- 
     1358 
     1359         CASE DEFAULT 
     1360            WRITE(numout,*) 'crs_init. Only jperio = 0, 1, 3, 4 supported' 
     1361         END SELECT 
     1362 
     1363         !========================================================================== 
     1364         ! send local start and end indices to all procs 
     1365         !========================================================================== 
     1366 
     1367         nldit_crs(:)=0 ; nleit_crs(:)=0 ; nlcit_crs(:)=0 ; nimppt_crs(:)=0 
     1368         nldjt_crs(:)=0 ; nlejt_crs(:)=0 ; nlcjt_crs(:)=0 ; njmppt_crs(:)=0 
     1369 
     1370         CALL mppgatheri((/nlci_crs/),0,nlcit_crs) ; CALL mppgatheri((/nlcj_crs/),0,nlcjt_crs)  
     1371         CALL mppgatheri((/nldi_crs/),0,nldit_crs) ; CALL mppgatheri((/nldj_crs/),0,nldjt_crs)  
     1372         CALL mppgatheri((/nlei_crs/),0,nleit_crs) ; CALL mppgatheri((/nlej_crs/),0,nlejt_crs)  
     1373         CALL mppgatheri((/nimpp_crs/),0,nimppt_crs) ; CALL mppgatheri((/njmpp_crs/),0,njmppt_crs)  
     1374 
     1375         DO jj = 1 ,jpnj 
     1376            DO ji = 1 , jpni 
     1377               jn=nfipproc(ji,jj)+1 
     1378               IF( jn .GE. 1 )THEN 
     1379                  nfiimpp_crs(ji,jj)=nimppt_crs(jn) 
     1380               ELSE 
     1381                  nfiimpp_crs(ji,jj) = ANINT( REAL( (nfiimpp(ji,jj) + 1 ) / nn_factx, wp ) ) + 1 
     1382               ENDIF 
     1383            ENDDO 
     1384         ENDDO 
    14111385  
    1412         !nogather=T 
    1413         nfsloop_crs = 1 
    1414         nfeloop_crs = nlci_crs 
    1415         DO jn = 2,jpni-1 
    1416            IF(nfipproc(jn,jpnj) .eq. (narea - 1)) THEN 
    1417               IF (nfipproc(jn - 1 ,jpnj) .eq. -1) THEN 
    1418                  nfsloop_crs = nldi_crs 
    1419               ENDIF 
    1420               IF (nfipproc(jn + 1,jpnj) .eq. -1) THEN 
    1421                  nfeloop_crs = nlei_crs 
    1422               ENDIF 
    1423            ENDIF 
    1424         END DO 
    1425  
    1426         !WRITE(narea+8000-1,*)"loc crs jpi nldi,nlei,nlci ",jpi_crs, nldi_crs            ,nlei_crs             ,nlci_crs 
    1427         !WRITE(narea+8000-1,*)"glo crs jpi nldi,nlei      ",jpi_crs, nldi_crs+nimpp_crs-1,nlei_crs+nimpp_crs-1 
    1428         !WRITE(narea+8000-1,*)"loc crs jpj nldj,nlej,nlcj ",jpj_crs, nldj_crs            ,nlej_crs             ,nlcj_crs 
    1429         !WRITE(narea+8000-1,*)"glo crs jpj nldj,nlej      ",jpj_crs, nldj_crs+njmpp_crs-1,nlej_crs+njmpp_crs-1 
    1430         !============================================================================================== 
    1431          IF( jpizoom /= 1 .OR. jpjzoom /= 1)    STOP  
    1432  
    1433       !                         Save the parent grid information 
    1434       jpi_full    = jpi 
    1435       jpj_full    = jpj 
    1436       jpim1_full  = jpim1 
    1437       jpjm1_full  = jpjm1 
    1438       nperio_full = nperio 
    1439  
    1440       npolj_full  = npolj 
    1441       jpiglo_full = jpiglo 
    1442       jpjglo_full = jpjglo 
    1443  
    1444       nlcj_full   = nlcj 
    1445       nlci_full   = nlci 
    1446       nldi_full   = nldi 
    1447       nldj_full   = nldj 
    1448       nlei_full   = nlei 
    1449       nlej_full   = nlej 
    1450       nimpp_full  = nimpp      
    1451       njmpp_full  = njmpp 
     1386         !nogather=T 
     1387         nfsloop_crs = 1 
     1388         nfeloop_crs = nlci_crs 
     1389         DO jn = 2,jpni-1 
     1390            IF( nfipproc(jn,jpnj) .eq. (narea - 1) )THEN 
     1391               IF (nfipproc(jn - 1 ,jpnj) .eq. -1 )THEN 
     1392                  nfsloop_crs = nldi_crs 
     1393               ENDIF 
     1394               IF( nfipproc(jn + 1,jpnj) .eq. -1 )THEN 
     1395                  nfeloop_crs = nlei_crs 
     1396               ENDIF 
     1397            ENDIF 
     1398         END DO 
     1399 
     1400         !WRITE(narea+8000-1,*)"loc crs jpi nldi,nlei,nlci ",jpi_crs, nldi_crs            ,nlei_crs             ,nlci_crs 
     1401         !WRITE(narea+8000-1,*)"glo crs jpi nldi,nlei      ",jpi_crs, nldi_crs+nimpp_crs-1,nlei_crs+nimpp_crs-1 
     1402         !WRITE(narea+8000-1,*)"loc crs jpj nldj,nlej,nlcj ",jpj_crs, nldj_crs            ,nlej_crs             ,nlcj_crs 
     1403         !WRITE(narea+8000-1,*)"glo crs jpj nldj,nlej      ",jpj_crs, nldj_crs+njmpp_crs-1,nlej_crs+njmpp_crs-1 
     1404         !============================================================================================== 
     1405         IF( jpizoom /= 1 .OR. jpjzoom /= 1)    STOP  !cbr mettre un ctlstp et ailleurs ( crsini ) 
     1406 
     1407         !========================================================================== 
     1408         ! Save the parent grid information 
     1409         !========================================================================== 
     1410         jpi_full    = jpi 
     1411         jpj_full    = jpj 
     1412         jpim1_full  = jpim1 
     1413         jpjm1_full  = jpjm1 
     1414         nperio_full = nperio 
     1415         npolj_full  = npolj 
     1416         jpiglo_full = jpiglo 
     1417         jpjglo_full = jpjglo 
     1418 
     1419         nlcj_full   = nlcj 
     1420         nlci_full   = nlci 
     1421         nldi_full   = nldi 
     1422         nldj_full   = nldj 
     1423         nlei_full   = nlei 
     1424         nlej_full   = nlej 
     1425         nimpp_full  = nimpp      
     1426         njmpp_full  = njmpp 
    14521427       
    1453       nlcit_full(:)  = nlcit(:) 
    1454       nldit_full(:)  = nldit(:) 
    1455       nleit_full(:)  = nleit(:) 
    1456       nimppt_full(:) = nimppt(:) 
    1457       nlcjt_full(:)  = nlcjt(:) 
    1458       nldjt_full(:)  = nldjt(:) 
    1459       nlejt_full(:)  = nlejt(:) 
    1460       njmppt_full(:) = njmppt(:) 
     1428         nlcit_full(:)  = nlcit(:) 
     1429         nldit_full(:)  = nldit(:) 
     1430         nleit_full(:)  = nleit(:) 
     1431         nimppt_full(:) = nimppt(:) 
     1432         nlcjt_full(:)  = nlcjt(:) 
     1433         nldjt_full(:)  = nldjt(:) 
     1434         nlejt_full(:)  = nlejt(:) 
     1435         njmppt_full(:) = njmppt(:) 
    14611436      
    1462       nfsloop_full = nfsloop 
    1463       nfeloop_full = nfeloop 
    1464  
    1465       nfiimpp_full(:,:) = nfiimpp(:,:)  
    1466  
    1467  
    1468       CALL dom_grid_crs  !swich de grille 
    1469       
    1470  
    1471       IF(lwp) THEN 
    1472          WRITE(numout,*) 
    1473          WRITE(numout,*) 'crs_init : coarse grid dimensions' 
    1474          WRITE(numout,*) '~~~~~~~   coarse domain global j-dimension           jpjglo = ', jpjglo 
    1475          WRITE(numout,*) '~~~~~~~   coarse domain global i-dimension           jpiglo = ', jpiglo 
    1476          WRITE(numout,*) '~~~~~~~   coarse domain local  i-dimension              jpi = ', jpi 
    1477          WRITE(numout,*) '~~~~~~~   coarse domain local  j-dimension              jpj = ', jpj 
    1478          WRITE(numout,*) 
    1479          WRITE(numout,*) ' nproc  = '     , nproc 
    1480          WRITE(numout,*) ' nlci   = '     , nlci 
    1481          WRITE(numout,*) ' nlcj   = '     , nlcj 
    1482          WRITE(numout,*) ' nldi   = '     , nldi 
    1483          WRITE(numout,*) ' nldj   = '     , nldj 
    1484          WRITE(numout,*) ' nlei   = '     , nlei 
    1485          WRITE(numout,*) ' nlej   = '     , nlej 
    1486          WRITE(numout,*) ' nlei_full='    , nlei_full 
    1487          WRITE(numout,*) ' nldi_full='    , nldi_full 
    1488          WRITE(numout,*) ' nimpp  = '     , nimpp 
    1489          WRITE(numout,*) ' njmpp  = '     , njmpp 
    1490          WRITE(numout,*) ' njmpp_full  = ', njmpp_full 
    1491          WRITE(numout,*) 
    1492       ENDIF 
     1437         nfsloop_full = nfsloop 
     1438         nfeloop_full = nfeloop 
     1439 
     1440         nfiimpp_full(:,:) = nfiimpp(:,:)  
     1441 
     1442 
     1443         !========================================================================== 
     1444         ! control 
     1445         !========================================================================== 
     1446         CALL dom_grid_crs  !swich from mother grid to coarsened grid 
     1447 
     1448         IF(lwp) THEN 
     1449            WRITE(numout,*) 
     1450            WRITE(numout,*) 'crs_init : coarse grid dimensions' 
     1451            WRITE(numout,*) '~~~~~~~   coarse domain global j-dimension           jpjglo = ', jpjglo 
     1452            WRITE(numout,*) '~~~~~~~   coarse domain global i-dimension           jpiglo = ', jpiglo 
     1453            WRITE(numout,*) '~~~~~~~   coarse domain local  i-dimension              jpi = ', jpi 
     1454            WRITE(numout,*) '~~~~~~~   coarse domain local  j-dimension              jpj = ', jpj 
     1455            WRITE(numout,*) 
     1456            WRITE(numout,*) ' nproc  = '     , nproc 
     1457            WRITE(numout,*) ' nlci   = '     , nlci 
     1458            WRITE(numout,*) ' nlcj   = '     , nlcj 
     1459            WRITE(numout,*) ' nldi   = '     , nldi 
     1460            WRITE(numout,*) ' nldj   = '     , nldj 
     1461            WRITE(numout,*) ' nlei   = '     , nlei 
     1462            WRITE(numout,*) ' nlej   = '     , nlej 
     1463            WRITE(numout,*) ' nlei_full='    , nlei_full 
     1464            WRITE(numout,*) ' nldi_full='    , nldi_full 
     1465            WRITE(numout,*) ' nimpp  = '     , nimpp 
     1466            WRITE(numout,*) ' njmpp  = '     , njmpp 
     1467            WRITE(numout,*) ' njmpp_full  = ', njmpp_full 
     1468            WRITE(numout,*) 
     1469         ENDIF 
    14931470       
    1494       CALL dom_grid_glo 
     1471         CALL dom_grid_glo ! switch from coarsened grid to mother grid 
    14951472       
    1496       mxbinctr   = INT( nn_factx * 0.5 ) 
    1497       mybinctr   = INT( nn_facty * 0.5 ) 
    1498  
    1499       nrestx = MOD( nn_factx, 2 )   ! check if even- or odd- numbered reduction factor 
    1500       nresty = MOD( nn_facty, 2 ) 
    1501  
    1502       IF ( nrestx == 0 ) THEN 
    1503          mxbinctr = mxbinctr - 1 
    1504       ENDIF 
    1505  
    1506       IF ( nresty == 0 ) THEN 
    1507          mybinctr = mybinctr - 1 
    1508          IF ( jperio == 3 .OR. jperio == 4 )  nperio_crs = jperio + 2 
    1509          IF ( jperio == 5 .OR. jperio == 6 )  nperio_crs = jperio - 2  
    1510  
    1511          IF ( npolj == 3 ) npolj_crs = 5 
    1512          IF ( npolj == 5 ) npolj_crs = 3 
    1513       ENDIF      
     1473         nrestx = MOD( nn_factx, 2 )   ! check if even- or odd- numbered reduction factor 
     1474         nresty = MOD( nn_facty, 2 ) 
     1475 
     1476         IF( nresty == 0 )THEN 
     1477            IF( jperio == 3 .OR. jperio == 4 )  nperio_crs = jperio + 2 
     1478            IF( jperio == 5 .OR. jperio == 6 )  nperio_crs = jperio - 2  
     1479            IF( npolj == 3 ) npolj_crs = 5 
     1480            IF( npolj == 5 ) npolj_crs = 3 
     1481         ENDIF      
    15141482       
    1515       rfactxy = nn_factx * nn_facty 
     1483         rfactxy = nn_factx * nn_facty 
    15161484       
    1517       ENDIF 
     1485      ENDIF ! lk_mpp 
    15181486      ! 
    15191487      nistr = mis_crs(2)  ;   niend = mis_crs(nlci_crs - 1) 

  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90

    r7217 r7222  
    6262      !!      2. At time of output, rescale [1] by dimension and time 
    6363      !!         to yield the spatial and temporal average. 
    64       !!  See. diawri_dimg.h90, sbcmod.F90 
    6564      !! 
    6665      !! ** Method  :   
    6766      !!---------------------------------------------------------------------- 
    6867      !! 
    69        
    7068      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
    7169      !! 
    72       INTEGER               ::   ji, jj, jk              ! dummy loop indices 
    73       !! 
     70      INTEGER                             :: ji, jj, jk              ! dummy loop indices 
     71      REAL(wp)                            :: z2dcrsu, z2dcrsv 
     72      REAL(wp)                            :: z1_2dt 
    7473      REAL(wp), POINTER, DIMENSION(:,:,:) :: zfse3t, zfse3u, zfse3v, zfse3w ! 3D workspace for e3 
    7574      REAL(wp), POINTER, DIMENSION(:,:,:) :: zt, zs , ztmp 
    7675      REAL(wp), POINTER, DIMENSION(:,:)   :: z2d,z2d_crs 
    7776      REAL(wp), POINTER, DIMENSION(:,:,:) :: zt_crs, zs_crs 
    78       REAL(wp):: z2dcrsu, z2dcrsv 
    79       REAL(wp):: z1_2dt 
    80       REAL(wp):: zmin,zmax 
    81       INTEGER :: i,j,ijis,ijie,ijjs,ijje 
    82       INTEGER ::  iji,ijj 
    83       INTEGER :: jl,jm,jn 
    84       !! 
    8577      !!---------------------------------------------------------------------- 
    8678 
    … …  
    216208      CALL crs_dom_e3( e1v, e2v, zfse3v, p_sfc_2d_crs=e1v_crs  , cd_type='V', p_mask=vmask, p_e3_crs=zs_crs, p_e3_max_crs=e3v_max_n_crs) 
    217209 
    218       !cbr ??????????????????? faut pas mettre le profile 1d plutot ??????????? 
    219       WHERE(e3t_max_n_crs == 0._wp) e3t_max_n_crs=r_inf 
    220       WHERE(e3u_max_n_crs == 0._wp) e3u_max_n_crs=r_inf 
    221       WHERE(e3v_max_n_crs == 0._wp) e3v_max_n_crs=r_inf 
    222       WHERE(e3w_max_n_crs == 0._wp) e3w_max_n_crs=r_inf 
     210      DO jk = 1, jpk 
     211         DO ji = 1, jpi_crs 
     212            DO jj = 1, jpj_crs 
     213               IF( e3t_max_n_crs(ji,jj,jk) == 0._wp ) e3t_max_n_crs(ji,jj,jk) = e3t_1d(jk) 
     214               IF( e3w_max_n_crs(ji,jj,jk) == 0._wp ) e3w_max_n_crs(ji,jj,jk) = e3w_1d(jk) 
     215               IF( e3u_max_n_crs(ji,jj,jk) == 0._wp ) e3u_max_n_crs(ji,jj,jk) = e3t_1d(jk) 
     216               IF( e3v_max_n_crs(ji,jj,jk) == 0._wp ) e3v_max_n_crs(ji,jj,jk) = e3t_1d(jk) 
     217            ENDDO 
     218         ENDDO 
     219      ENDDO 
    223220 
    224221      ! depth 
    225222      CALL crs_dom_ope( gdepw_n, 'MAX', 'T', tmask, gdept_n_crs, p_e3=zfse3t, psgn=1.0 ) 
    226223      CALL crs_dom_ope( gdepw_n, 'MAX', 'W', tmask, gdepw_n_crs, p_e3=zfse3w, psgn=1.0 ) 
     224      DO jk = 1, jpk 
     225         DO ji = 1, jpi_crs 
     226            DO jj = 1, jpj_crs 
     227               IF( gdept_n_crs(ji,jj,jk) .LE. 0._wp ) gdept_n_crs(ji,jj,jk) = gdept_1d(jk) 
     228               IF( gdepw_n_crs(ji,jj,jk) .LE. 0._wp ) gdepw_n_crs(ji,jj,jk) = gdepw_1d(jk) 
     229            ENDDO 
     230         ENDDO 
     231      ENDDO 
    227232 
    228233      ! volume and facvol 
    … …  
    257262      !  U-velocity 
    258263      CALL crs_dom_ope( un, 'SUM', 'U', umask, un_crs, p_e12=e2u, p_e3=zfse3u, p_surf_crs=e2e3u_msk, psgn=-1.0 ) 
    259       un_crs(:,:,:) = un_crs(:,:,:)*umask_crs(:,:,:) !cbr utile ?????????????????? 
    260264      CALL iom_put( "uoce"  , un_crs )   ! i-current  
    261265 
    262266      !  V-velocity 
    263267      CALL crs_dom_ope( vn, 'SUM', 'V', vmask, vn_crs, p_e12=e1v, p_e3=zfse3v, p_surf_crs=e1e3v_msk, psgn=-1.0 ) 
    264       vn_crs(:,:,:) = vn_crs(:,:,:)*vmask_crs(:,:,:) !cbr utile ?????????????????? 
    265268      CALL iom_put( "voce"  , vn_crs )   ! i-current  
    266269 
    … …  
    346349      zfse3t(:,:,:) = 1._wp 
    347350      zt(:,:,:) = tmask(:,:,:) 
    348       ssha(:,:) = ssha(:,:) * tmask(:,:,1)  !cbr utile ?????????????????? 
    349351      CALL crs_dom_ope( ssha , 'VOL', 'T', zt, ssha_crs , p_e12=e1e2t,  p_e3=zfse3t , psgn=1.0 ) 
    350352 
    … …  
    371373      ENDDO 
    372374 
    373       !zt_crs=ocean_volume_crs_t ; zs_crs=facvol_t after time !!! ça sert à quoi ??????????????????????????????????????????? 
    374       CALL crs_dom_facvol( tmask, 'T', e1t, e2t, zfse3t, zt_crs, zs_crs ) 
    375  
    376 #endif 
    377  
    378 #if defined key_vvl 
     375#endif 
     376 
     377#if defined key_vvl 
     378 
    379379      z1_2dt = 1._wp / ( 2. * rdt )                         ! set time step size (Euler/Leapfrog) 
    380380      IF( neuler == 0 .AND. kt == nit000 )   z1_2dt = 1._wp / rdt 
     381 
    381382      wn_crs(:,:,jpk) = 0._wp 
    382383      DO jk = jpkm1, 1, -1 
    … …  
    399400 
    400401#endif 
    401       CALL crs_lbc_lnk( wn_crs, 'W', 1.0 )   !!!!!!!pas utile, nan ?????????????????????? 
    402       wn_crs(:,:,:) = wn_crs(:,:,:) * tmask_crs(:,:,:)   !!!!!!!pas utile, nan ?????????????????????? 
    403  
    404402      CALL iom_put( "woce", wn_crs  )   ! vertical velocity 
    405403 
     404      !--------------------------------------------------------------------------------------------------- 
    406405      !  free memory 
    407406      CALL wrk_dealloc( jpi, jpj, jpk, zfse3t, zfse3w ) 

  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trcstp.F90

    r6772 r7222  
    132132      INTEGER  :: jn 
    133133 
    134       IF( kt == nittrc000 ) THEN 
     134      IF( kt == nit000 ) THEN 
    135135         IF( ln_cpl )  THEN   
    136136            rdt_sampl = 86400. / ncpl_qsr_freq 
Note: See TracChangeset for help on using the changeset viewer.