Changeset 16 for trunk/NEMO/OPA_SRC/SOL/solisl.F90
- Timestamp:
- 2004-02-17T09:06:15+01:00 (20 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/OPA_SRC/SOL/solisl.F90 (modified) (22 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/SOL/solisl.F90
r3 r16 36 36 37 37 !! * Shared module variables 38 LOGICAL, PUBLIC :: & 39 l_isl = .TRUE. ! 'key_islands' flag 38 LOGICAL, PUBLIC, PARAMETER :: l_isl = .TRUE. !: 'key_islands' flag 40 39 41 40 !! * module variable … … 157 156 zwb(jpi,:) = 0.e0 158 157 ENDIF 159 # if defined key_mpp 160 ! Mpp: export boundary values to neighboring processors 161 CALL lbc_lnk( zwb, 'G', 1. ) 162 # endif 158 IF( lk_mpp ) CALL lbc_lnk( zwb, 'G', 1. ) 163 159 164 160 165 161 ! 1. Initialization for the search of island grid-points 166 162 ! ------------------------------------------------------ 167 # if defined key_mpp 168 169 ! Mpp : The overlap region are not taken into account 170 ! (islands bondaries are searched over subdomain only) 171 iista = 1 + jpreci 172 iiend = nlci - jpreci 173 ijsta = 1 + jprecj 174 ijend = nlcj - jprecj 175 ijstm1= 1 + jprecj 176 ijenm1= nlcj - jprecj 177 IF( nbondi == -1 .OR. nbondi == 2 ) THEN 163 164 IF( lk_mpp ) THEN 165 166 ! Mpp : The overlap region are not taken into account 167 ! (islands bondaries are searched over subdomain only) 168 iista = 1 + jpreci 169 iiend = nlci - jpreci 170 ijsta = 1 + jprecj 171 ijend = nlcj - jprecj 172 ijstm1= 1 + jprecj 173 ijenm1= nlcj - jprecj 174 IF( nbondi == -1 .OR. nbondi == 2 ) THEN 175 iista = 1 176 ENDIF 177 IF( nbondi == 1 .OR. nbondi == 2 ) THEN 178 iiend = nlci 179 ENDIF 180 IF( nbondj == -1 .OR. nbondj == 2 ) THEN 181 ijsta = 1 182 ijstm1 = 2 183 ENDIF 184 IF( nbondj == 1 .OR. nbondj == 2 ) THEN 185 ijend = nlcj 186 ijenm1 = nlcj-1 187 ENDIF 188 IF( npolj == 3 .OR. npolj == 4 ) THEN 189 ijend = nlcj-2 190 ijenm1 = nlcj-2 191 ENDIF 192 ELSE 193 ! mono- or macro-tasking environnement: full domain scan 178 194 iista = 1 179 ENDIF 180 IF( nbondi == 1 .OR. nbondi == 2 ) THEN 181 iiend = nlci 182 ENDIF 183 IF( nbondj == -1 .OR. nbondj == 2 ) THEN 195 iiend = jpi 184 196 ijsta = 1 185 197 ijstm1 = 2 186 ENDIF 187 IF( nbondj == 1 .OR. nbondj == 2 ) THEN 188 ijend = nlcj 189 ijenm1 = nlcj-1 190 ENDIF 191 IF( npolj == 3 .OR. npolj == 4 ) THEN 192 ijend = nlcj-2 193 ijenm1 = nlcj-2 194 ENDIF 195 # else 196 197 ! mono- or macro-tasking environnement: full domain scan 198 iista = 1 199 iiend = jpi 200 ijsta = 1 201 ijstm1 = 2 202 IF( nperio == 3 .OR. nperio == 4 ) THEN 203 ijend = jpj-2 204 ijenm1 = jpj-2 205 ELSEIF( nperio == 5 .OR. nperio == 6 ) THEN 206 ijend = jpj-1 207 ijenm1 = jpj-1 208 ELSE 209 ijend = jpj 210 ijenm1 = jpj-1 211 ENDIF 212 # endif 198 IF( nperio == 3 .OR. nperio == 4 ) THEN 199 ijend = jpj-2 200 ijenm1 = jpj-2 201 ELSEIF( nperio == 5 .OR. nperio == 6 ) THEN 202 ijend = jpj-1 203 ijenm1 = jpj-1 204 ELSE 205 ijend = jpj 206 ijenm1 = jpj-1 207 ENDIF 208 ENDIF 213 209 214 210 … … 247 243 inilt = inilt + indil(jj) 248 244 END DO 249 # if defined key_mpp 250 CALL mpp_sum( inilt ) 251 # endif 245 IF( lk_mpp ) CALL mpp_sum( inilt ) ! sum over the global domain 246 252 247 IF( inilt == 0 ) THEN 253 248 IF(lwp) THEN … … 255 250 WRITE(numout,*) ' change parameter.h' 256 251 ENDIF 257 STOP 'isldom' 252 STOP 'isldom' !cr replace by nstop 258 253 ENDIF 259 254 … … 381 376 ! Take account of redundant points 382 377 383 # if defined key_mpp 384 CALL mpp_sum( ip ) 385 # endif 378 IF( lk_mpp ) CALL mpp_sum( ip ) ! sum over the global domain 386 379 387 380 IF( ip > jpnisl ) THEN … … 391 384 WRITE(numout,*) ' change parameter.h' 392 385 ENDIF 393 STOP 'isldom' 386 STOP 'isldom' !cr => nstop 394 387 ENDIF 395 388 … … 409 402 410 403 inilt = isrchne( jpij, zwb(1,1), 1, 0. ) 411 # if defined key_mpp 412 CALL mpp_min( inilt ) 413 # endif 404 IF( lk_mpp ) CALL mpp_min( inilt ) ! min over the global domain 414 405 415 406 IF( inilt /= jpij+1 ) THEN … … 426 417 ! ---------------------------------------- 427 418 428 CALL isl pri419 CALL isl_pri 429 420 430 421 … … 432 423 ! ------------------------------------------------------- 433 424 434 CALL isl pth425 CALL isl_pth 435 426 436 427 END SUBROUTINE isl_dom … … 466 457 ipe = mnisl(3,jni) 467 458 ipw = mnisl(4,jni) 468 # if defined key_mpp 469 CALL mpp_sum( ip )470 CALL mpp_sum( ipn )471 CALL mpp_sum( ips )472 CALL mpp_sum( ipe )473 CALL mpp_sum( ipw )474 # endif 459 IF( lk_mpp ) THEN 460 CALL mpp_sum( ip ) ! sums over the global domain 461 CALL mpp_sum( ipn ) 462 CALL mpp_sum( ips ) 463 CALL mpp_sum( ipe ) 464 CALL mpp_sum( ipw ) 465 ENDIF 475 466 IF(lwp) THEN 476 467 WRITE(numout,9000) jni … … 484 475 END DO 485 476 486 ! FORMAT 487 477 ! FORMAT !!cr => no more format 488 478 9000 FORMAT(/, /, 'island number= ', i2 ) 489 479 9010 FORMAT(/, 'npil=',i4,' npn=',i3,' nps=',i3,' npe=',i3,' npw=',i3 ) … … 514 504 !!---------------------------------------------------------------------- 515 505 !! * Local declarations 516 INTEGER :: j i, jj, jni, jii, jnp ! dummy loop indices517 INTEGER :: ii, ij 506 INTEGER :: jni, jii, jnp ! dummy loop indices 507 INTEGER :: ii, ij ! temporary integers 518 508 !!---------------------------------------------------------------------- 519 509 … … 587 577 REAL(wp), DIMENSION(jpi,jpj) :: zlamt, zphit 588 578 REAL(wp), DIMENSION(jpi,jpj,2) :: zwx 589 # if defined key_mpp590 579 REAL(wp), DIMENSION(jpisl*jpisl) :: ztab 591 # endif592 580 !!---------------------------------------------------------------------- 593 581 … … 674 662 675 663 END DO 676 # if defined key_mpp 677 DO jnj=1,jpisl 678 DO jni=1,jpisl 679 ztab(jni+(jnj-1)*jpisl) = aisl(jni,jnj) 680 END DO 681 END DO 682 683 CALL mpp_sum( ztab, jpisl*jpisl ) 684 !! CALL mpp_sum( aisl, jpisl*jpisl ) 685 # endif 664 IF( lk_mpp ) THEN 665 DO jnj = 1, jpisl 666 DO jni = 1, jpisl 667 ztab(jni+(jnj-1)*jpisl) = aisl(jni,jnj) 668 END DO 669 END DO 670 CALL mpp_sum( ztab, jpisl*jpisl ) ! sum over the global domain 671 !! CALL mpp_sum( aisl, jpisl*jpisl ) 672 ENDIF 686 673 687 674 ! 1.3 Control print … … 775 762 REAL(wp) :: zep(jpisl), zlamt(jpi,jpj), zphit(jpi,jpj), zdept(1), zprec(4) 776 763 REAL(wp) :: zdate0, zdt 777 # if defined key_mpp 764 REAL(wp) :: t2p1(jpi,1,1) 778 765 INTEGER :: iloc 779 # endif780 766 !!---------------------------------------------------------------------- 781 767 … … 907 893 ! Right hand side of the streamfunction equation 908 894 909 # if defined key_mpp 910 911 ! north fold treatment 912 IF( npolj == 3 .OR. npolj == 5) iloc=jpiglo-(nimpp-1+nimppt(nono+1)-1) 913 IF( npolj == 4 .OR. npolj == 6) iloc=jpiglo-2*(nimpp-1) 914 t2p1(:,1,1) = 0.e0 915 ! north and south grid-points 916 DO jii = 1, 2 917 DO jnp = 1, mnisl(jii,jni) 918 ii = miisl(jnp,jii,jni) 919 ij = mjisl(jnp,jii,jni) 920 IF( ( npolj == 3 .OR. npolj == 4 ) .AND. & 921 ( ij == nlcj-1 .AND. jii == 1) ) THEN 922 iju=iloc-ii+1 923 t2p1(iju,1,1) = t2p1(iju,1,1) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij) 924 ELSEIF( ( npolj == 5 .OR. npolj == 6 ) .AND. & 925 ( ij == nlcj-1 .AND. jii == 1) ) THEN 926 iju=iloc-ii 927 gcb(ii,ij) = gcb(ii,ij) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij) 928 t2p1(iju,1,1) = t2p1(iju,1,1) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij) 929 ELSE 930 gcb(ii,ij-jii+1) = gcb(ii,ij-jii+1) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij) 931 ENDIF 932 END DO 933 END DO 934 935 ! east and west grid-points 936 937 DO jii = 3, 4 938 DO jnp = 1, mnisl(jii,jni) 939 ii = miisl(jnp,jii,jni) 940 ij = mjisl(jnp,jii,jni) 941 gcb(ii-jii+3,ij) = gcb(ii-jii+3,ij) + hvr(ii,ij) * e2v(ii,ij) / e1v(ii,ij) 942 END DO 943 END DO 944 CALL mpplnks( gcb ) 945 946 # else 947 948 ! north and south grid-points 949 DO jii = 1, 2 950 DO jnp = 1, mnisl(jii,jni) 951 ii = miisl(jnp,jii,jni) 952 ij = mjisl(jnp,jii,jni) 953 IF( ( nperio == 3 .OR. nperio == 4 ) .AND. & 954 ( ij == jpj-1 .AND. jii == 1) ) THEN 955 gcb(jpi-ii+1,ij-1) = gcb(jpi-ii+1,ij-1) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij) 956 ELSEIF( ( nperio == 5 .OR. nperio == 6 ) .AND. & 957 ( ij == jpj-1 .AND. jii == 1) ) THEN 958 gcb(ii,ij) = gcb(ii,ij) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij) 959 gcb(jpi-ii,ij) = gcb(jpi-ii,ij) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij) 960 ELSE 961 gcb(ii,ij-jii+1) = gcb(ii,ij-jii+1) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij) 962 ENDIF 963 END DO 964 END DO 965 966 ! east and west grid-points 967 DO jii = 3, 4 968 DO jnp = 1, mnisl(jii,jni) 969 ii = miisl(jnp,jii,jni) 970 ij = mjisl(jnp,jii,jni) 971 IF( bmask(ii-jii+3,ij) /= 0. ) THEN 895 IF( lk_mpp ) THEN 896 897 ! north fold treatment 898 IF( npolj == 3 .OR. npolj == 5) iloc=jpiglo-(nimpp-1+nimppt(nono+1)-1) 899 IF( npolj == 4 .OR. npolj == 6) iloc=jpiglo-2*(nimpp-1) 900 t2p1(:,1,1) = 0.e0 901 ! north and south grid-points 902 DO jii = 1, 2 903 DO jnp = 1, mnisl(jii,jni) 904 ii = miisl(jnp,jii,jni) 905 ij = mjisl(jnp,jii,jni) 906 IF( ( npolj == 3 .OR. npolj == 4 ) .AND. & 907 ( ij == nlcj-1 .AND. jii == 1) ) THEN 908 iju=iloc-ii+1 909 t2p1(iju,1,1) = t2p1(iju,1,1) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij) 910 ELSEIF( ( npolj == 5 .OR. npolj == 6 ) .AND. & 911 ( ij == nlcj-1 .AND. jii == 1) ) THEN 912 iju=iloc-ii 913 gcb(ii,ij) = gcb(ii,ij) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij) 914 t2p1(iju,1,1) = t2p1(iju,1,1) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij) 915 ELSE 916 gcb(ii,ij-jii+1) = gcb(ii,ij-jii+1) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij) 917 ENDIF 918 END DO 919 END DO 920 921 ! east and west grid-points 922 923 DO jii = 3, 4 924 DO jnp = 1, mnisl(jii,jni) 925 ii = miisl(jnp,jii,jni) 926 ij = mjisl(jnp,jii,jni) 972 927 gcb(ii-jii+3,ij) = gcb(ii-jii+3,ij) + hvr(ii,ij) * e2v(ii,ij) / e1v(ii,ij) 973 ELSE 974 975 ! east-west cyclic boundary conditions 976 IF( ii-jii+3 == 1 ) THEN 977 gcb(jpim1,ij) = gcb(jpim1,ij) + hvr(ii,ij) * e2v(ii,ij) / e1v(ii,ij) 928 END DO 929 END DO 930 931 IF( lk_mpp ) CALL mpplnks( gcb ) !!bug ? should use an lbclnk ? is it possible? 932 933 ELSE 934 935 ! north and south grid-points 936 DO jii = 1, 2 937 DO jnp = 1, mnisl(jii,jni) 938 ii = miisl(jnp,jii,jni) 939 ij = mjisl(jnp,jii,jni) 940 IF( ( nperio == 3 .OR. nperio == 4 ) .AND. & 941 ( ij == jpj-1 .AND. jii == 1) ) THEN 942 gcb(jpi-ii+1,ij-1) = gcb(jpi-ii+1,ij-1) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij) 943 ELSEIF( ( nperio == 5 .OR. nperio == 6 ) .AND. & 944 ( ij == jpj-1 .AND. jii == 1) ) THEN 945 gcb(ii,ij) = gcb(ii,ij) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij) 946 gcb(jpi-ii,ij) = gcb(jpi-ii,ij) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij) 947 ELSE 948 gcb(ii,ij-jii+1) = gcb(ii,ij-jii+1) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij) 978 949 ENDIF 979 ENDIF 980 END DO 981 END DO 982 983 # endif 950 END DO 951 END DO 952 953 ! east and west grid-points 954 DO jii = 3, 4 955 DO jnp = 1, mnisl(jii,jni) 956 ii = miisl(jnp,jii,jni) 957 ij = mjisl(jnp,jii,jni) 958 IF( bmask(ii-jii+3,ij) /= 0. ) THEN 959 gcb(ii-jii+3,ij) = gcb(ii-jii+3,ij) + hvr(ii,ij) * e2v(ii,ij) / e1v(ii,ij) 960 ELSE 961 ! east-west cyclic boundary conditions 962 IF( ii-jii+3 == 1 ) THEN 963 gcb(jpim1,ij) = gcb(jpim1,ij) + hvr(ii,ij) * e2v(ii,ij) / e1v(ii,ij) 964 ENDIF 965 ENDIF 966 END DO 967 END DO 968 ENDIF 984 969 985 970 ! Preconditioned right hand side and absolute precision … … 1011 996 END DO 1012 997 END DO 1013 # if defined key_mpp 1014 CALL mpp_sum( rnorme ) 1015 # endif 998 IF( lk_mpp ) CALL mpp_sum( rnorme ) ! sum over the global domain 999 1016 1000 IF(lwp) WRITE(numout,*) 'rnorme ', rnorme 1017 1001 epsr = epsisl * epsisl * rnorme … … 1070 1054 END DO 1071 1055 ENDIF 1072 # if defined key_mpp 1073 CALL lbc_lnk( bsfisl(:,:,jni), 'G', 1. ) 1074 # endif 1056 IF( lk_mpp ) CALL lbc_lnk( bsfisl(:,:,jni), 'G', 1. ) ! link at G-point 1075 1057 1076 1058 … … 1212 1194 END DO 1213 1195 END DO 1214 # if defined key_mpp 1215 ! Mpp : global sum to obtain global dot from local ones 1216 CALL mpp_sum( bisl, jpisl ) 1217 # endif 1196 IF( lk_mpp ) CALL mpp_sum( bisl, jpisl ) ! sum over the global domain 1197 1218 1198 DO jni = 1, jpisl ! Island stream function trend 1219 1199 visl(jni) = 0.e0 … … 1270 1250 zfact = 1.e-6 * bsfn(miisl(1,0,jni),mjisl(1,0,jni)) 1271 1251 ENDIF 1272 # if defined key_mpp 1273 CALL mpp_isl( zfact ) 1274 # endif 1252 IF( lk_mpp ) CALL mpp_isl( zfact ) 1253 1275 1254 IF(lwp) WRITE(numisp,9300) kt, jni, zfact, visl(jni) 1276 1255 IF( MOD( kt, nwrite ) == 0 .OR. kindic < 0 & … … 1293 1272 !! Default option Empty module 1294 1273 !!---------------------------------------------------------------------- 1295 LOGICAL, PUBLIC :: l_isl = .FALSE. !'key_islands' flag1274 LOGICAL, PUBLIC, PARAMETER :: l_isl = .FALSE. !: 'key_islands' flag 1296 1275 CONTAINS 1297 1276 SUBROUTINE isl_dom ! Empty routine … … 1304 1283 END SUBROUTINE isl_dyn_spg 1305 1284 SUBROUTINE isl_stp_ctl( kt, kindic ) ! Empty routine 1306 WRITE(*,*) kt, kindic ! no compilation warning1285 WRITE(*,*) 'isl_stp_ctl: You should not have seen this print! error?', kt, kindic 1307 1286 END SUBROUTINE isl_stp_ctl 1308 1287 #endif
Note: See TracChangeset
for help on using the changeset viewer.
