SUBROUTINE cnmmod(ARRAY,CS,IMX0,JMX0,IMX,JMX,C,cof,NCOEF,WK) use cons_module,only: pi ! am_02/02: cnmmod: cnm subroutine modified for modified mudpack solver ! calculates the modified and unmodified coefficient stencils ! modified: C-array all grid levels ! unmodified: cof-array only finest grid ! modification in stencil at 1,3,5,7,9 made to preserve diagional dominance implicit none C **** C **** COMPUTE CONTRIBUTION TO STENCIL FROM ZIGM(NCOEF) ON GRID C **** IMX BY JMX. FINEST GRID IS IMX0 BY JMX0. C **** C **** INPUT: C **** ARRAY(-15:IMX0+16,JMX0) C **** ARRAY OF ZIGM ON GRID IMX0 BY JMX0 EXTENDED USING C **** SYMMETRY AND PERIODICITY C **** CS(JMX0) C **** ARRAY OF COSINES OF LATITUDE VALUES C **** NCOEF = NUMBER IDENTIFYING COEFFICIENT C **** NCOEF = 1 FOR ZIGM11 C **** NCOEF = 2 FOR ZIGM12 (=ZIGMC+ZIGM2) C **** NCOEF = 3 FOR ZIGM21 (=ZIGMC-ZIGM2) C **** NCOEF = 4 FOR ZIGM22 C **** C **** OUTPUT: C **** C(IMX,JMX,9) C **** ARRAY FOR GRID POINT STENCILS AT RESOLUTION C **** IMX BY JMX C **** ! ! Args: integer,intent(in) :: imx0,jmx0,imx,jmx,ncoef real,intent(in) :: ARRAY(IMX0+32,1),CS(*) real,intent(out) :: C(IMX,JMX,*),WK(IMX0,3) real,intent(out) :: cof(IMX,JMX,9) ! ! Local: real :: pi integer :: nint,i0,j0,i,j C **** C **** COMPUTE SEPARATION OF GRID POINTS OF RESOLUTION C **** IMX BY JMX WITHIN GRID OF RESOLUTION IMX0 BY JMX0. C **** EVALUATE DLON AND DLAT, GRID SPACING OF IMX BY JMX. C **** NINT = (IMX0-1)/(IMX-1) C **** C **** SCAN ARRAY IMX BY JMX CALCULATING AND ADDING C **** CONTRIBUTIONS TO STENCIL FROM ZIGM(NCOEF) C **** I0 = 1-NINT J0 = 1-NINT C **** C **** INDENTIFY COEFFICIENT UNDER CONSIDERATION C **** IF(NCOEF.EQ.1)THEN C **** C **** CALCULATIONS FOR ZIGM11 C **** ! am_02/02: include bounary condition at the equator DO 1 J = 1,JMX-1 DO 1 I = 1,IMX C(I,J,1) = C(I,J,1)+.5*(ARRAY(I0+I*NINT,J0+J*NINT)+ ! modified 1 ARRAY(I0+(I+1)*NINT,J0+J*NINT)) C(I,J,5) = C(I,J,5)+.5*(ARRAY(I0+I*NINT,J0+J*NINT)+ 1 ARRAY(I0+(I-1)*NINT,J0+J*NINT)) C(I,J,9) = C(I,J,9)-.5*(ARRAY(I0+(I+1)*NINT,J0+J*NINT)+ 1 2.*ARRAY(I0+I*NINT,J0+J*NINT)+ 2 ARRAY(I0+(I-1)*NINT,J0+J*NINT)) cof(i,j,1) = cof(i,j,1)+.5*(ARRAY(I0+I*NINT,J0+J*NINT)+ ! unmodified 1 ARRAY(I0+(I+1)*NINT,J0+J*NINT)) cof(i,j,5) = cof(i,j,5)+.5*(ARRAY(I0+I*NINT,J0+J*NINT)+ 1 ARRAY(I0+(I-1)*NINT,J0+J*NINT)) cof(i,j,9) = cof(i,j,9)-.5*(ARRAY(I0+(I+1)*NINT,J0+J*NINT) 1 +2.*ARRAY(I0+I*NINT,J0+J*NINT)+ 2 ARRAY(I0+(I-1)*NINT,J0+J*NINT)) 1 CONTINUE ELSE IF(NCOEF.EQ.2)THEN C **** C **** CALCULATIONS FOR ZIGM12 (=ZIGMC+ZIGM2) C **** DO 2 J = 2,JMX-1 DO 2 I = 1,IMX C(I,J,2) = C(I,J,2)+.5*(ARRAY(I0+I*NINT,J0+J*NINT)+ ! modified 1 ARRAY(I0+(I+1)*NINT,J0+J*NINT)) C(I,J,4) = C(I,J,4)-.5*(ARRAY(I0+I*NINT,J0+J*NINT)+ 1 ARRAY(I0+(I-1)*NINT,J0+J*NINT)) C(I,J,6) = C(I,J,6)+.5*(ARRAY(I0+I*NINT,J0+J*NINT)+ 1 ARRAY(I0+(I-1)*NINT,J0+J*NINT)) C(I,J,8) = C(I,J,8)-.5*(ARRAY(I0+I*NINT,J0+J*NINT)+ 1 ARRAY(I0+(I+1)*NINT,J0+J*NINT)) WK(I,1) = .5*(ARRAY(I0+(I+1)*NINT,J0+J*NINT)- 1 ARRAY(I0+(I-1)*NINT,J0+J*NINT)) cof(i,j,2) = c(i,j,2) ! unmodified cof(i,j,4) = c(i,j,4) cof(i,j,6) = c(i,j,6) cof(i,j,8) = c(i,j,8) cof(i,j,3) = cof(i,j,3)+wk(i,1) cof(i,j,7) = cof(i,j,7)-wk(i,1) WK(I,2) = (C(I,J,3)+WK(I,1))*(C(I,J,7)-WK(I,1)) ! modification WK(I,3) = SIGN(WK(I,1),C(I,J,3)+C(I,J,7)) if (wk(i,2) >= 0.) wk(i,3) = 0. C(I,J,3) = C(I,J,3)+WK(I,1)+WK(I,3) C(I,J,7) = C(I,J,7)-WK(I,1)+WK(I,3) C(I,J,9) = C(I,J,9)-2.*WK(I,3) 2 CONTINUE ELSE IF(NCOEF.EQ.3)THEN C **** C **** CALCULATIONS FOR ZIGM21 (=ZIGMC-ZIGM2) C **** DO 3 J = 2,JMX-1 DO 3 I = 1,IMX C(I,J,2) = C(I,J,2)+.5*(ARRAY(I0+I*NINT,J0+J*NINT)+ ! modified 1 ARRAY(I0+I*NINT,J0+(J+1)*NINT)) C(I,J,4) = C(I,J,4)-.5*(ARRAY(I0+I*NINT,J0+J*NINT)+ 1 ARRAY(I0+I*NINT,J0+(J+1)*NINT)) C(I,J,6) = C(I,J,6)+.5*(ARRAY(I0+I*NINT,J0+J*NINT)+ 1 ARRAY(I0+I*NINT,J0+(J-1)*NINT)) C(I,J,8) = C(I,J,8)-.5*(ARRAY(I0+I*NINT,J0+J*NINT)+ 1 ARRAY(I0+I*NINT,J0+(J-1)*NINT)) WK(I,1) = .5*(ARRAY(I0+I*NINT,J0+(J+1)*NINT)- 1 ARRAY(I0+I*NINT,J0+(J-1)*NINT)) cof(i,j,2) = c(i,j,2) ! unmodified cof(i,j,4) = c(i,j,4) cof(i,j,6) = c(i,j,6) cof(i,j,8) = c(i,j,8) cof(i,j,1) = cof(i,j,1)+wk(i,1) cof(i,j,5) = cof(i,j,5)-wk(i,1) WK(I,2) = (C(I,J,1)+WK(I,1))*(C(I,J,5)-WK(I,1)) ! modification WK(I,3) = SIGN(WK(I,1),C(I,J,1)+C(I,J,5)) if (wk(i,2) >= 0.) wk(i,3) = 0. C(I,J,1) = C(I,J,1)+WK(I,1)+WK(I,3) C(I,J,5) = C(I,J,5)-WK(I,1)+WK(I,3) C(I,J,9) = C(I,J,9)-2.*WK(I,3) 3 CONTINUE C **** C **** LOW LATITUDE BOUNDARY CONDITION C **** J = 1 DO 6 I = 1,IMX C(I,J,2) = C(I,J,2)+.5*(ARRAY(I0+I*NINT,J0+J*NINT)+ ! modified 1 ARRAY(I0+I*NINT,J0+(J+1)*NINT)) C(I,J,4) = C(I,J,4)-.5*(ARRAY(I0+I*NINT,J0+J*NINT)+ 1 ARRAY(I0+I*NINT,J0+(J+1)*NINT)) WK(I,1) = .5*(ARRAY(I0+I*NINT,J0+J*NINT)+ 1 ARRAY(I0+I*NINT,J0+(J+1)*NINT)) cof(i,j,2) = c(i,j,2) ! unmodified cof(i,j,4) = c(i,j,4) cof(i,j,1) = cof(i,j,1)+wk(i,1) cof(i,j,5) = cof(i,j,5)-wk(i,1) WK(I,2) = (C(I,J,1)+WK(I,1))*(C(I,J,5)-WK(I,1)) ! modification WK(I,3) = SIGN(WK(I,1),C(I,J,1)+C(I,J,5)) if (wk(i,2) >= 0.) wk(i,3) = 0. C(I,J,1) = C(I,J,1)+WK(I,1)+WK(I,3) C(I,J,5) = C(I,J,5)-WK(I,1)+WK(I,3) C(I,J,9) = C(I,J,9)-2.*WK(I,3) 6 CONTINUE ELSE IF(NCOEF.EQ.4)THEN C **** C **** CALCULATIONS FOR ZIGM22 C **** DO 4 J = 2,JMX-1 DO 4 I = 1,IMX C(I,J,3) = C(I,J,3)+.5*(ARRAY(I0+I*NINT,J0+J*NINT) ! modified 1 +ARRAY(I0+I*NINT,J0+(J+1)*NINT)) C(I,J,7) = C(I,J,7)+.5*(ARRAY(I0+I*NINT,J0+J*NINT) 1 +ARRAY(I0+I*NINT,J0+(J-1)*NINT)) C(I,J,9) = C(I,J,9)-.5*(ARRAY(I0+I*NINT,J0+(J-1)*NINT) 1 +2.*ARRAY(I0+I*NINT,J0+J*NINT) 2 +ARRAY(I0+I*NINT,J0+(J+1)*NINT)) cof(i,j,3) = cof(i,j,3)+.5*(ARRAY(I0+I*NINT,J0+J*NINT) ! unmodified 1 +ARRAY(I0+I*NINT,J0+(J+1)*NINT)) cof(i,j,7) = cof(i,j,7)+.5*(ARRAY(I0+I*NINT,J0+J*NINT) 1 +ARRAY(I0+I*NINT,J0+(J-1)*NINT)) cof(i,j,9) = cof(i,j,9)-.5*(ARRAY(I0+I*NINT,J0+(J-1)*NINT) 1 +2.*ARRAY(I0+I*NINT,J0+J*NINT) 2 +ARRAY(I0+I*NINT,J0+(J+1)*NINT)) 4 CONTINUE C **** C **** LOW LATITUDE BOUNDARY CONDITION C **** J = 1 DO 7 I = 1,IMX C(I,J,3) = C(I,J,3)+.5*(ARRAY(I0+I*NINT,J0+J*NINT) ! modified 1 +ARRAY(I0+I*NINT,J0+(J+1)*NINT)) C(I,J,9) = C(I,J,9)-.5*( 1 ARRAY(I0+I*NINT,J0+J*NINT) 2 +ARRAY(I0+I*NINT,J0+(J+1)*NINT)) cof(i,j,3) = cof(i,j,3)+.5*(ARRAY(I0+I*NINT,J0+J*NINT) ! unmodified 1 +ARRAY(I0+I*NINT,J0+(J+1)*NINT)) cof(i,j,9) = cof(i,j,9)-.5*( 1 ARRAY(I0+I*NINT,J0+J*NINT) 2 +ARRAY(I0+I*NINT,J0+(J+1)*NINT)) 7 CONTINUE ENDIF RETURN END C