SUBROUTINE AREAMASKER(kx,ngrid,idim,jdim,mska,iddif,jddif, * m1,idstart,idend,jdstart,jdend,nbasin,mixer,mtot) C AREAMASKS CONSTRUCTS MASK OF DIFFERENT AREAS OF THE C OCEAN C OCEAN BASIN INFORMATION IS IN FILE C /OCL/SYS.INF/AREAMASK.1DEG c************************************************************** c c Passed Variables: c kx - depth level for mask c ngrid - grid size of graph c mska - 1=mask out this area of ocean for each area c iddif,jddif - number of grid spacings in the x and c y directions for graph c m1 - array containing full longitude, latitude grid c idstart,idend - horizontal starting and ending points for graph c jdstart,jdend - vertical starting and ending points for graph c nbasin - number of areas c c************************************************************** c************************************************************** c c Parameters: c masknum - maximum number of basin masks c mostmask - maximum number of indices for basins c kdim - number of depth levels c idim0 - number of longitudes c c************************************************************** parameter (masknum=100,mostmask=30,kdim=40,idim0=360) parameter (kdimax=300) character*7 nosouth,nonorth character*60 abasin character*80 filename common /southset/ nosouth common /northset/ nonorth c************************************************************** c c Arrays: c num - number of indices per area mask c masker - temporary area mask c mtot - the number of areas per depth level c c The rest of the arrays hold the indices for each basin. c The indices are the i,j coordinates which bound the basin. c c The four elements in the first array dimension are: c 1 - starting longitude c 2 - ending longitude c 3 - starting latitude c 4 - ending latitude c c*************************************************************** dimension m1(iddif,jddif) dimension xmasker2(4,mostmask,masknum) dimension num(masknum),masker(4,mostmask,masknum), * mtot(masknum),mska(masknum),mixer(masknum) dimension kalt(kdimax) save kalt c************************************************* c c Set up kalt in case an alternate set of standard c depths is in use c c************************************************** call equivalentdepths(kalt,kdimax) c******************************************************** c c Read in information on area coverage c c******************************************************** call clearstring(filename,80) call extraname('sys.inf'//CHAR(0), * 'areamask.1deg'//CHAR(0),filename) open(12,file=filename,status='old') nbasin=0 xgrid=ngrid xgridx=.5/xgrid do 100 nn=1,masknum read(12,802,end=4) mtotx, mnum, mixer(mnum), num(mnum),abasin nbasin=nbasin+1 mtot(mnum) = mtotx do 101 n2=1,num(mnum) read(12,801) (xmasker2(n3,n2,mnum),n3=1,4) do 405 n3=1,4 if ( n3 .le. 2 ) then xmasker2(n3,n2,mnum) = xmasker2(n3,n2,mnum) + 90. elseif ( xmasker2(n3,n2,mnum) .le. 0. ) then xmasker2(n3,n2,mnum) = xmasker2(n3,n2,mnum) + 360. if ( n3 .eq. 3 .and. xmasker2(n3,n2,mnum) .ge. 360. ) * xmasker2(n3,n2,mnum)= 0. endif if (mod(n3,2).eq.0) then masker(n3,n2,mnum)=(xmasker2(n3,n2,mnum)*xgrid)+xgridx else masker(n3,n2,mnum)= (xmasker2(n3,n2,mnum)*xgrid) +1.+xgridx endif 405 continue 101 continue c800 format(3(i4,','),i4) 801 format(3(f7.2,1x),f7.2) 802 format(i2,i3,i4,5x,i3,2x,a60) read(12,*) 100 continue 4 close(12) c****************************************************** c c Above depth 31, do not completely close the c North American (30) and West European (31) basins c c****************************************************** if (kalt(kx).lt.31) then num(30)=7 num(31)=7 mixer(35)=2 mixer(30)=0 mixer(31)=0 endif if ( kalt(kx) .lt. 13 ) mixer(4)=-1 if ( kalt(kx) .lt. 15 ) mixer(11)=-1 c***************************************************** c c Initialize m1 c c***************************************************** do 40 j=1,jddif do 41 i=1,iddif m1(i,j)= 0 41 continue 40 continue c****************************************************** c c Run through each basin for this depth c c****************************************************** do 50 m=1,nbasin c skip southern ocean if nosouth set if ( nosouth .eq. 'nosouth' .and. m .eq. 10) goto 50 c skip arctic ocean if nosouth set if ( nonorth .eq. 'nonorth' .and. m .eq. 11) goto 50 if ( m .eq. 59 ) * write(6,*) 'mtot',nbasin,m,mtot(m),kx,kalt(kx) if (mtot(m) .le. kalt(kx) ) then c****************************************************** c c n2 is the marker for this basin. If this basin is c not requested to be blocked, set n2 to zero, else c set n2 to the basin number. c c****************************************************** n2=0 if ( mska(m).gt.0 ) n2=m c******************************************* c c Run through each set of indices, putting c the proper values at the proper points c c******************************************* do 53 n=1,num(m) j1=masker(1,n,m) j2=masker(2,n,m) i1=masker(3,n,m) i2=masker(4,n,m) if ( m .eq. 59 ) * write(6,*) 'x',n,j1,j2,i1,i2, * idstart,idend,jdstart,jdend do 54 j=j1,j2 jx=j-jdstart+1 if ( j .ge. jdstart .and. j .le. jdend ) then do 55 i=i1,i2 if ( idend .ge. idstart ) then if ( i .ge. idstart .and. i .le. idend ) then ix=i-idstart+1 else goto 55 endif else if ( i .ge. idstart ) then ix=i-idstart+1 elseif ( i .le. idend ) then ix= ((ngrid*idim0)-idstart)+i+1 else goto 55 endif endif if ( ix .eq. 1800 .and. jx .eq. 900 ) then c write(6,*) 'n2',n2,m1(ix,jx),m,mtot(m), c * mtot(m1(ix,jx)) endif if ( m1(ix,jx) .eq. 0 ) then m1(ix,jx)=n2 elseif ( mtot(m) .ge. mtot(m1(ix,jx)) ) then m1(ix,jx)=n2 endif 55 continue endif 54 continue 53 continue endif 50 continue return end