c97caution: program f90test code97: f90test.f redone to test for what f90 constructs run in f90 on t3e code96: f90test.f redone to test for what f90 constructs run in cf77 code95: retest=cf6testre.f redone 2y later, 01oct95, changes over 93 test code93: test if cm Fort90 array functions work for cf77 v6.0 c96error: => cray cft77v6.0.4.28 flagged for error integer b(2,3),s2(2),s3(3) integer c(2,2),ct(3,2),cs(3,4),as(4),at(3),ctr1(2),ctr2(2),ctr3(2) integer a(2,3),cu(2,3),ar1(3),ar2(3),cst(4,3) integer bi(2,2),br1(3),br2(3),b2(2),cr1(2),cr2(2),iter logical test(2,3),inmask(64,64) real u(64,64),du(64,64),us(8,8),diffav intrinsic sum,maxval,minval,product,dot_product,matmul,transpose & ,cshift,eoshift,spread,ranf cf97replace data b/1,2,3,4,5,6/ !replace constructors initialization data as/2,3,4,5/ data at/2,3,4/ c -------------------- c97error: b(1,1:3) = (/1, 3, 5/) ! initialize first row, along dimension 2. c97error: b(2,1:3) = (/2, 4, 6/) ! initialize second row, along dimension 2. b(1,1:3) = (/1, 3, 5/) ! initialize first row, along dimension 2. b(2,1:3) = (/2, 4, 6/) ! initialize second row, along dimension 2. print*,'Note: constructors like "(/1,2/)" ARE allowed in f90?' br1 = b(1,:) br2 = b(2,:) print60,br1,br2 60 format(' b(2,3)'/(3i3)) c -------------------- isum = sum(b) ! => isum = 21; i.e., Front-End scalar. print61,' isum=sum(b)=',isum 61 format(1x,a32,i4) isum = sum(b(:,1:3:2)) ! => isum = 14; sole ':' means all values '1:2'. print61,' isum = sum("b(:,1:3:2)")=',isum bi=b(:,1:3:2) isum=sum(bi) print61,' isum = sum("b(:,1:3:2)")=',isum cf6error:s2 = sum(b,dim=2) ! declared with the correct array section shape. print*,'CAUTION: "dim=", etc., markers= NOT allowed in intrinsics' s2 = sum(b,2) ! redeclared with the correct array section shape. print62,' s2 = sum(b,2)=',s2 ! => s2 = (/9,12/), row sums 62 format(1x,a32,2i3) s3 = sum(b,1) ! => s3 = (/3,7,11/); column sums. print63,' s3 = sum(b,1)=',s3 63 format(1x,a32,3i3) cf6error:isum = sum(b,mask=b.gt.3) ! =>isum = 18; i.e., add only elements print*,'CAUTION: "mask=" marker= STILL not allowed either.' s3 = sum(b,1,b.gt.3) ! => s3 = (/0,4,11/); i.e., conditional col sum print63,' s3 = sum(b,1,"b.gt.3") =',s3 test=b.gt.3 s3 = sum(b,1,test) ! => s3 = (/0,4,11/); i.e., conditional col sum print63,' s3 = sum(b,1,"b.gt.3") =',s3 s2 = sum(b,2,test) ! => s2 = (/5,10/); i.e., conditional row sum print62,' s2 = sum(b,2,b.gt.3) =',s2 cf6error:isum = sum(b,,test) ! => isum = 18; i.e., add only elements cf6error:print61,' isum = sum(b,,b.gt.3) =',isum ! that are greater than three. c96error: isum = sum(b,0,test) ! => isum = 18; i.e., add only elements c96error:print61,' isum = sum(b,0,b.gt.3) =',isum ! that are greater than three. isum = sum(b,test) ! => isum = 18; i.e., add only elements print61,' isum = sum(b,b.gt.3) =',isum ! that are greater than three. isum = sum(b,mask=test) ! => isum = 18; i.e., add only elements print61,' isum = sum(b,mask=b.gt.3) =',isum ! that are greater than three. print*,' CAUTION: If "sum(array[dim[,mask]])", use zero (0)' & ,' for [dim] for whole array when there is a mask.' c -------------------- imax = maxval(b) ! => imax = 6; array maximum value. print61,' imax = maxval(b)=',imax s3 = maxval(b,1) ! => s3 = (/2,4,6/); column maximums. print63,' s3 = maxval(b,1)=',s3 s2 = maxval(b,2) ! => s2 = (/5,6/); row maximums. print62,' s2 = maxval(b,2)=',s2 c -------------------- imin = minval(b) ! => imin = 1; array minimum value. print61,' imin = minval(b)=',imin c -------------------- s2 = product(b,2) ! => s2 = (/15,48/); products of column elements. print62,' s2 = product(b,2)=',s2 c -------------------- idot = dot_product(br1,br2) ! => idot = 44; dot product of row print61,' idot = dot_product(b(1,:),b(2,:))=',idot ! vectors of b. print*,' CAUTION: cf77v60 spelling with "_" different from' & ,' cmfortran.' print*,' CAUTION: Array syntax not allowed in actual arguments.' c -------------------- ! assuming array b of the previous section. ![Ans] = matmul([Array_1],[Array_2]) ! computes matrix multiplication ! of two rank two matrices. c = matmul(b(:,1:2),b(:,2:3)) ! => c(1,:)=(/15,23/);c(2,:)=(/22,34/). c=transpose(c) print623,'c=matmul(b(:,1:2),b(:,2:3))=',c 623 format(1x,a36/(2i3)) ![Ans] = transpose([Array]) ! transforms an array to its transpose. ct = transpose(b) ! => ct(1,:)=(/1,2/);ct(2,:)=(/3,4/);ct(3,:)=(/5,6/). ctr1 = ct(1,:) ctr2 = ct(2,:) ctr3 = ct(3,:) print623,'ct = transpose(b)=',ctr1,ctr2,ctr3 c -------------------- ! assume b is again initialized as ! b = 1 3 5 ! 2 4 6 a = cshift(b,1,2) ! => a = 3 5 1 ! 4 6 2 ar1 = a(1,:) ar2 = a(2,:) print*,' CAUTION: Arg order "cshift(array,shift[,dim])",' & ,' not cmfortran.' print633,'a = cshift(a,1,2)=',ar1,ar2 633 format(1x,a36/(3i3)) ! i.e., b(i,j+shift) -> a(i,j) for j=1:2, etc.; ! i.e., the result is computed from shifting subscript in specified ! dimension of the source array by the specified shift. a = cshift(b,-1,2) ! => a = 5 1 3 ! 6 2 4 ar1 = a(1,:) ar2 = a(2,:) print633,'a = cshift(b,-1,2)=',ar1,ar2 ! i.e., b(i,j+shift) -> a(i,j) for j=2:3, etc. s2(1) = 1 s2(2) = 2 a = cshift(b,s2,2) ! a = 3 5 1 ! 6 2 4 ! i.e., an array-valued shift, or shift per row. ar1 = a(1,:) ar2 = a(2,:) print633,'a = cshift(b,(/1,2/),2)=',ar1,ar2 c -------------------- ! Jacobi Iteration for a 5-star discretization of ! 2D Laplace's equation: u = 0 u(1,:)=2 u(64,:)=2 u(:,1)=2 u(:,64)=1 inmask = .FALSE. inmask(2:63,2:63) = .TRUE. diffav = 1 iter=0 do while (diffav.gt.5.e-3.and.iter.lt.100) iter=iter+1 du = 0 where(inmask) du = 0.25*(cshift(u,1,1)+cshift(u,-1,1)+cshift(u,1,2) & +cshift(u,-1,2)) - u u = u + du end where du = du*du diffav = sqrt(sum(du)/(62*62)) end do ! which is the main program fragment of laplace.fcm. cf90error:print66,'u = laplace-shift(u)=',u(1:64:16,1:64:16) cf90error: & ,' array section like "u(1:64:16,1:64:16)".' print*,'CAUTION: array sections not allowed in print' us = u(1:64:9,1:64:9) us=transpose(us) print66,'u = laplace-shift(u)= ; iter=',iter,'; av-diff =' & ,diffav,us 66 format(1x,a21,i8,a7,e10.3/(8f7.3)) c -------------------- a = eoshift(b,-1,0,1) ! a = 0 0 0 note default boundary value is 0. ! 1 3 5 print*,'CAUTION: Arg order "eoshift(array,shift[,boundary' & ,'[,dim]])", not cmf.' ar1 = a(1,:) ar2 = a(2,:) print633,'a = eoshift(b,-1,0,1)=',ar1,ar2 c96error: s2=(/-1,0/) c96error: b2=(/7,8/) s2=(/-1,0/) b2=(/7,8/) a = eoshift(b,s2,b2,2) ! => a = 7 1 3 ! 2 4 6 ar1 = a(1,:) ar2 = a(2,:) print633,'a = eoshift(b,(/-1,0/),(/7,8/),2)=',ar1,ar2 a = eoshift(b,2,0,2) ! => a = 5 0 0 ! => 6 0 0 ar1 = a(1,:) ar2 = a(2,:) print623,'a = eoshift(b,2,2)=',ar1,ar2 c -------------------- cs = spread(as,1,3) ! contents of cs: ! 2 3 4 5 ! 2 3 4 5 ! 2 3 4 5 cst = transpose(cs) print64,'as =',as 64 format(1x,a32,4i3) print643,'cs = spread(as,1,3)=',cst 643 format(1x,a36/(4i3)) c -------------------- cs = spread(at,2,4) ! contents of c: ! 2 2 2 2 ! 3 3 3 3 ! 4 4 4 4 cst = transpose(cs) print63,'at =',at print643,'cs = spread(at,2,4)=',cst c --------------------------------------------------------------------------- ! i.e., b=spread(a,d,c) => ! a(n_1,n_2,...,n_(d-1),n_d,...,n_r) -> b(n_1,n_2,...,n_(d-1),c,n_d,...,n_r) ! where r is the rank of source array a and n_i is the size of dimension i; ! noting that a new dimension of size c is added before dimension d. c --------------------------------------------------------------- print*,'F90 random_number DOES work with f90, unlike cf77' call random_number(uniform) print660,'uniform random variate =',uniform c96caution: ranf also needs to be declared intrinsic as part of F90 Math, c96warning: ranf takes no or null argument only, but ranf is outmoded. uniform=ranf() print660,'uniform random variate =',uniform uniform=ranf() print660,'uniform random variate =',uniform 660 format(1x,a,f9.6) c -------------------- stop end