450 lines
18 KiB
Plaintext
Executable File
450 lines
18 KiB
Plaintext
Executable File
#if defined MULTI
|
|
# define NAT_IN(k) cd_nat(k)
|
|
# define SGN_IN(k) psgn(k)
|
|
# define F_SIZE(ptab) kfld
|
|
# if defined DIM_2d
|
|
# if defined SINGLE_PRECISION
|
|
# define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_2D_sp),INTENT(inout)::ptab(f)
|
|
# else
|
|
# define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_2D_dp),INTENT(inout)::ptab(f)
|
|
# endif
|
|
# define ARRAY_IN(i,j,k,l,f) ptab(f)%pt2d(i,j)
|
|
# define K_SIZE(ptab) 1
|
|
# define L_SIZE(ptab) 1
|
|
# endif
|
|
# if defined DIM_3d
|
|
# if defined SINGLE_PRECISION
|
|
# define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_3D_sp),INTENT(inout)::ptab(f)
|
|
# else
|
|
# define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_3D_dp),INTENT(inout)::ptab(f)
|
|
# endif
|
|
# define ARRAY_IN(i,j,k,l,f) ptab(f)%pt3d(i,j,k)
|
|
# define K_SIZE(ptab) SIZE(ptab(1)%pt3d,3)
|
|
# define L_SIZE(ptab) 1
|
|
# endif
|
|
# if defined DIM_4d
|
|
# if defined SINGLE_PRECISION
|
|
# define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_4D_sp),INTENT(inout)::ptab(f)
|
|
# else
|
|
# define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_4D_dp),INTENT(inout)::ptab(f)
|
|
# endif
|
|
# define ARRAY_IN(i,j,k,l,f) ptab(f)%pt4d(i,j,k,l)
|
|
# define K_SIZE(ptab) SIZE(ptab(1)%pt4d,3)
|
|
# define L_SIZE(ptab) SIZE(ptab(1)%pt4d,4)
|
|
# endif
|
|
# if defined SINGLE_PRECISION
|
|
# define ARRAY2_TYPE(i,j,k,l,f) TYPE(PTR_4D_sp),INTENT(inout)::ptab2(f)
|
|
# else
|
|
# define ARRAY2_TYPE(i,j,k,l,f) TYPE(PTR_4D_dp),INTENT(inout)::ptab2(f)
|
|
# endif
|
|
# define J_SIZE(ptab2) SIZE(ptab2(1)%pt4d,2)
|
|
# define ARRAY2_IN(i,j,k,l,f) ptab2(f)%pt4d(i,j,k,l)
|
|
#else
|
|
! !== IN: ptab is an array ==!
|
|
# define NAT_IN(k) cd_nat
|
|
# define SGN_IN(k) psgn
|
|
# define F_SIZE(ptab) 1
|
|
# if defined DIM_2d
|
|
# define ARRAY_IN(i,j,k,l,f) ptab(i,j)
|
|
# define K_SIZE(ptab) 1
|
|
# define L_SIZE(ptab) 1
|
|
# endif
|
|
# if defined DIM_3d
|
|
# define ARRAY_IN(i,j,k,l,f) ptab(i,j,k)
|
|
# define K_SIZE(ptab) SIZE(ptab,3)
|
|
# define L_SIZE(ptab) 1
|
|
# endif
|
|
# if defined DIM_4d
|
|
# define ARRAY_IN(i,j,k,l,f) ptab(i,j,k,l)
|
|
# define K_SIZE(ptab) SIZE(ptab,3)
|
|
# define L_SIZE(ptab) SIZE(ptab,4)
|
|
# endif
|
|
# define J_SIZE(ptab2) SIZE(ptab2,2)
|
|
# define ARRAY2_IN(i,j,k,l,f) ptab2(i,j,k,l)
|
|
# if defined SINGLE_PRECISION
|
|
# define ARRAY_TYPE(i,j,k,l,f) REAL(sp),INTENT(inout)::ARRAY_IN(i,j,k,l,f)
|
|
# define ARRAY2_TYPE(i,j,k,l,f) REAL(sp),INTENT(inout)::ARRAY2_IN(i,j,k,l,f)
|
|
# else
|
|
# define ARRAY_TYPE(i,j,k,l,f) REAL(dp),INTENT(inout)::ARRAY_IN(i,j,k,l,f)
|
|
# define ARRAY2_TYPE(i,j,k,l,f) REAL(dp),INTENT(inout)::ARRAY2_IN(i,j,k,l,f)
|
|
# endif
|
|
# endif
|
|
# ifdef SINGLE_PRECISION
|
|
# define PRECISION sp
|
|
# else
|
|
# define PRECISION dp
|
|
# endif
|
|
SUBROUTINE ROUTINE_NFD( ptab, ptab2, cd_nat, psgn, kfld )
|
|
!!----------------------------------------------------------------------
|
|
!!
|
|
!! ** Purpose : lateral boundary condition : North fold treatment
|
|
!! without allgather exchanges.
|
|
!!
|
|
!!----------------------------------------------------------------------
|
|
ARRAY_TYPE(:,:,:,:,:)
|
|
ARRAY2_TYPE(:,:,:,:,:)
|
|
CHARACTER(len=1) , INTENT(in ) :: NAT_IN(:) ! nature of array grid-points
|
|
REAL(wp) , INTENT(in ) :: SGN_IN(:) ! sign used across the north fold boundary
|
|
INTEGER, OPTIONAL, INTENT(in ) :: kfld ! number of pt3d arrays
|
|
!
|
|
INTEGER :: ji, jj, jk, jn, ii, jl, jh, jf ! dummy loop indices
|
|
INTEGER :: ipi, ipj, ipk, ipl, ipf, iij, ijj ! dimension of the input array
|
|
INTEGER :: ijt, iju, ijta, ijua, jia, startloop, endloop
|
|
LOGICAL :: l_fast_exchanges
|
|
!!----------------------------------------------------------------------
|
|
ipj = J_SIZE(ptab2) ! 2nd dimension of input array
|
|
ipk = K_SIZE(ptab) ! 3rd dimension of output array
|
|
ipl = L_SIZE(ptab) ! 4th -
|
|
ipf = F_SIZE(ptab) ! 5th - use in "multi" case (array of pointers)
|
|
!
|
|
! Security check for further developments
|
|
IF ( ipf > 1 ) CALL ctl_stop( 'STOP', 'lbc_nfd_nogather: multiple fields not allowed. Revise implementation...' )
|
|
! 2nd dimension determines exchange speed
|
|
IF (ipj == 1 ) THEN
|
|
l_fast_exchanges = .TRUE.
|
|
ELSE
|
|
l_fast_exchanges = .FALSE.
|
|
ENDIF
|
|
!
|
|
DO jf = 1, ipf ! Loop over the number of arrays to be processed
|
|
!
|
|
SELECT CASE ( npolj )
|
|
!
|
|
CASE ( 3, 4 ) ! * North fold T-point pivot
|
|
!
|
|
SELECT CASE ( NAT_IN(jf) )
|
|
!
|
|
CASE ( 'T' , 'W' ) ! T-, W-point
|
|
IF ( nimpp /= 1 ) THEN ; startloop = 1
|
|
ELSE ; startloop = 1 + nn_hls
|
|
ENDIF
|
|
!
|
|
DO jl = 1, ipl; DO jk = 1, ipk
|
|
DO jj = 1, nn_hls
|
|
ijj = jpj -jj +1
|
|
DO ji = startloop, jpi
|
|
ijt = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 4
|
|
ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,jj,jk,jl,jf)
|
|
END DO
|
|
END DO
|
|
END DO; END DO
|
|
IF( nimpp == 1 ) THEN
|
|
DO jl = 1, ipl; DO jk = 1, ipk
|
|
DO jj = 1, nn_hls
|
|
ijj = jpj -jj +1
|
|
DO ii = 0, nn_hls-1
|
|
ARRAY_IN(ii+1,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii+1,jpj-2*nn_hls+jj-1,jk,jl,jf)
|
|
END DO
|
|
END DO
|
|
END DO; END DO
|
|
ENDIF
|
|
!
|
|
IF ( .NOT. l_fast_exchanges ) THEN
|
|
IF( nimpp >= Ni0glo/2+2 ) THEN
|
|
startloop = 1
|
|
ELSEIF( nimpp+jpi-1 >= Ni0glo/2+2 .AND. nimpp < Ni0glo/2+2 ) THEN
|
|
startloop = Ni0glo/2+2 - nimpp + nn_hls
|
|
ELSE
|
|
startloop = jpi + 1
|
|
ENDIF
|
|
IF( startloop <= jpi ) THEN
|
|
DO jl = 1, ipl; DO jk = 1, ipk
|
|
DO ji = startloop, jpi
|
|
ijt = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 4
|
|
jia = ji + nimpp - 1
|
|
ijta = jpiglo - jia + 2
|
|
IF( ijta >= startloop+nimpp-1 .AND. ijta < jia ) THEN
|
|
ARRAY_IN(ji,jpj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ijta-nimpp+nn_hls,jpj-nn_hls,jk,jl,jf)
|
|
ELSE
|
|
ARRAY_IN(ji,jpj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,nn_hls+1,jk,jl,jf)
|
|
ENDIF
|
|
END DO
|
|
END DO; END DO
|
|
ENDIF
|
|
ENDIF
|
|
CASE ( 'U' ) ! U-point
|
|
IF( nimpp + jpi - 1 /= jpiglo ) THEN
|
|
endloop = jpi
|
|
ELSE
|
|
endloop = jpi - nn_hls
|
|
ENDIF
|
|
DO jl = 1, ipl; DO jk = 1, ipk
|
|
DO jj = 1, nn_hls
|
|
ijj = jpj -jj +1
|
|
DO ji = 1, endloop
|
|
iju = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 3
|
|
ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,jj,jk,jl,jf)
|
|
END DO
|
|
END DO
|
|
END DO; END DO
|
|
IF (nimpp .eq. 1) THEN
|
|
DO jj = 1, nn_hls
|
|
ijj = jpj -jj +1
|
|
DO ii = 0, nn_hls-1
|
|
ARRAY_IN(ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii,jpj-2*nn_hls+jj-1,:,:,jf)
|
|
END DO
|
|
END DO
|
|
ENDIF
|
|
IF((nimpp + jpi - 1) .eq. jpiglo) THEN
|
|
DO jj = 1, nn_hls
|
|
ijj = jpj -jj +1
|
|
DO ii = 1, nn_hls
|
|
ARRAY_IN(jpi-ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(jpi-2*nn_hls+ii,jpj-2*nn_hls+jj-1,:,:,jf)
|
|
END DO
|
|
END DO
|
|
ENDIF
|
|
!
|
|
IF ( .NOT. l_fast_exchanges ) THEN
|
|
IF( nimpp + jpi - 1 /= jpiglo ) THEN
|
|
endloop = jpi
|
|
ELSE
|
|
endloop = jpi - nn_hls
|
|
ENDIF
|
|
IF( nimpp >= Ni0glo/2+1 ) THEN
|
|
startloop = nn_hls
|
|
ELSEIF( ( nimpp + jpi - 1 >= Ni0glo/2+1 ) .AND. ( nimpp < Ni0glo/2+1 ) ) THEN
|
|
startloop = Ni0glo/2+1 - nimpp + nn_hls
|
|
ELSE
|
|
startloop = endloop + 1
|
|
ENDIF
|
|
IF( startloop <= endloop ) THEN
|
|
DO jl = 1, ipl; DO jk = 1, ipk
|
|
DO ji = startloop, endloop
|
|
iju = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 3
|
|
jia = ji + nimpp - 1
|
|
ijua = jpiglo - jia + 1
|
|
IF( ijua >= startloop+nimpp-1 .AND. ijua < jia ) THEN
|
|
ARRAY_IN(ji,jpj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ijua-nimpp+1,jpj-nn_hls,jk,jl,jf)
|
|
ELSE
|
|
ARRAY_IN(ji,jpj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,nn_hls+1,jk,jl,jf)
|
|
ENDIF
|
|
END DO
|
|
END DO; END DO
|
|
ENDIF
|
|
ENDIF
|
|
!
|
|
CASE ( 'V' ) ! V-point
|
|
IF( nimpp /= 1 ) THEN
|
|
startloop = 1
|
|
ELSE
|
|
startloop = 1 + nn_hls
|
|
ENDIF
|
|
IF ( .NOT. l_fast_exchanges ) THEN
|
|
DO jl = 1, ipl; DO jk = 1, ipk
|
|
DO jj = 2, nn_hls+1
|
|
ijj = jpj -jj +1
|
|
DO ji = startloop, jpi
|
|
ijt=jpiglo - ji - nimpp - nfimpp(isendto(1)) + 4
|
|
ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,jj,jk,jl,jf)
|
|
END DO
|
|
END DO
|
|
END DO; END DO
|
|
ENDIF
|
|
DO jl = 1, ipl; DO jk = 1, ipk
|
|
DO ji = startloop, jpi
|
|
ijt=jpiglo - ji - nimpp - nfimpp(isendto(1)) + 4
|
|
ARRAY_IN(ji,jpj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,1,jk,jl,jf)
|
|
END DO
|
|
END DO; END DO
|
|
IF (nimpp .eq. 1) THEN
|
|
DO jj = 1, nn_hls
|
|
ijj = jpj-jj+1
|
|
DO ii = 0, nn_hls-1
|
|
ARRAY_IN(ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii+1,jpj-2*nn_hls+jj-1,:,:,jf)
|
|
END DO
|
|
END DO
|
|
ENDIF
|
|
CASE ( 'F' ) ! F-point
|
|
IF( nimpp + jpi - 1 /= jpiglo ) THEN
|
|
endloop = jpi
|
|
ELSE
|
|
endloop = jpi - nn_hls
|
|
ENDIF
|
|
IF ( .NOT. l_fast_exchanges ) THEN
|
|
DO jl = 1, ipl; DO jk = 1, ipk
|
|
DO jj = 2, nn_hls+1
|
|
ijj = jpj -jj +1
|
|
DO ji = 1, endloop
|
|
iju = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 3
|
|
ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,jj,jk,jl,jf)
|
|
END DO
|
|
END DO
|
|
END DO; END DO
|
|
ENDIF
|
|
DO jl = 1, ipl; DO jk = 1, ipk
|
|
DO ji = 1, endloop
|
|
iju = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 3
|
|
ARRAY_IN(ji,jpj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,1,jk,jl,jf)
|
|
END DO
|
|
END DO; END DO
|
|
IF (nimpp .eq. 1) THEN
|
|
DO ii = 1, nn_hls
|
|
ARRAY_IN(ii,jpj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii,jpj-2*nn_hls-1,:,:,jf)
|
|
END DO
|
|
IF ( .NOT. l_fast_exchanges ) THEN
|
|
DO jj = 1, nn_hls
|
|
ijj = jpj -jj
|
|
DO ii = 0, nn_hls-1
|
|
ARRAY_IN(ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii,jpj-2*nn_hls+jj-1,:,:,jf)
|
|
END DO
|
|
END DO
|
|
ENDIF
|
|
ENDIF
|
|
IF((nimpp + jpi - 1 ) .eq. jpiglo) THEN
|
|
DO ii = 1, nn_hls
|
|
ARRAY_IN(jpi-ii+1,jpj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(jpi-2*nn_hls+ii,jpj-2*nn_hls-1,:,:,jf)
|
|
END DO
|
|
IF ( .NOT. l_fast_exchanges ) THEN
|
|
DO jj = 1, nn_hls
|
|
ijj = jpj -jj
|
|
DO ii = 1, nn_hls
|
|
ARRAY_IN(jpi-ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(jpi-2*nn_hls+ii,jpj-2*nn_hls+jj-1,:,:,jf)
|
|
END DO
|
|
END DO
|
|
ENDIF
|
|
ENDIF
|
|
!
|
|
END SELECT
|
|
!
|
|
CASE ( 5, 6 ) ! * North fold F-point pivot
|
|
!
|
|
SELECT CASE ( NAT_IN(jf) )
|
|
CASE ( 'T' , 'W' ) ! T-, W-point
|
|
DO jl = 1, ipl; DO jk = 1, ipk
|
|
DO jj = 1, nn_hls
|
|
ijj = jpj-jj+1
|
|
DO ji = 1, jpi
|
|
ijt = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 3
|
|
ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,jj,jk,jl,jf)
|
|
END DO
|
|
END DO
|
|
END DO; END DO
|
|
!
|
|
CASE ( 'U' ) ! U-point
|
|
IF( nimpp + jpi - 1 /= jpiglo ) THEN
|
|
endloop = jpi
|
|
ELSE
|
|
endloop = jpi - nn_hls
|
|
ENDIF
|
|
DO jl = 1, ipl; DO jk = 1, ipk
|
|
DO jj = 1, nn_hls
|
|
ijj = jpj-jj+1
|
|
DO ji = 1, endloop
|
|
iju = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 2
|
|
ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,jj,jk,jl,jf)
|
|
END DO
|
|
END DO
|
|
END DO; END DO
|
|
IF(nimpp + jpi - 1 .eq. jpiglo) THEN
|
|
DO jl = 1, ipl; DO jk = 1, ipk
|
|
DO jj = 1, nn_hls
|
|
ijj = jpj-jj+1
|
|
DO ii = 1, nn_hls
|
|
iij = jpi-ii+1
|
|
ARRAY_IN(iij,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(jpi-2*nn_hls+ii-1,jpj-2*nn_hls+jj,jk,jl,jf)
|
|
END DO
|
|
END DO
|
|
END DO; END DO
|
|
ENDIF
|
|
!
|
|
CASE ( 'V' ) ! V-point
|
|
DO jl = 1, ipl; DO jk = 1, ipk
|
|
DO jj = 1, nn_hls
|
|
ijj = jpj -jj +1
|
|
DO ji = 1, jpi
|
|
ijt = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 3
|
|
ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,jj,jk,jl,jf)
|
|
END DO
|
|
END DO
|
|
END DO; END DO
|
|
|
|
IF ( .NOT. l_fast_exchanges ) THEN
|
|
IF( nimpp >= Ni0glo/2+2 ) THEN
|
|
startloop = 1
|
|
ELSEIF( nimpp+jpi-1 >= Ni0glo/2+2 .AND. nimpp < Ni0glo/2+2 ) THEN
|
|
startloop = Ni0glo/2+2 - nimpp + nn_hls
|
|
ELSE
|
|
startloop = jpi + 1
|
|
ENDIF
|
|
IF( startloop <= jpi ) THEN
|
|
DO jl = 1, ipl; DO jk = 1, ipk
|
|
DO ji = startloop, jpi
|
|
ijt = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 3
|
|
ARRAY_IN(ji,jpj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,nn_hls+1,jk,jl,jf)
|
|
END DO
|
|
END DO; END DO
|
|
ENDIF
|
|
ENDIF
|
|
!
|
|
CASE ( 'F' ) ! F-point
|
|
IF( nimpp + jpi - 1 /= jpiglo ) THEN
|
|
endloop = jpi
|
|
ELSE
|
|
endloop = jpi - nn_hls
|
|
ENDIF
|
|
DO jl = 1, ipl; DO jk = 1, ipk
|
|
DO jj = 1, nn_hls
|
|
ijj = jpj -jj +1
|
|
DO ji = 1, endloop
|
|
iju = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 2
|
|
ARRAY_IN(ji,ijj ,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,jj,jk,jl,jf)
|
|
END DO
|
|
END DO
|
|
END DO; END DO
|
|
IF((nimpp + jpi - 1) .eq. jpiglo) THEN
|
|
DO jl = 1, ipl; DO jk = 1, ipk
|
|
DO jj = 1, nn_hls
|
|
ijj = jpj -jj +1
|
|
DO ii = 1, nn_hls
|
|
iij = jpi -ii+1
|
|
ARRAY_IN(iij,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(jpi-2*nn_hls+ii-1,jpj-2*nn_hls+jj-1,jk,jl,jf)
|
|
END DO
|
|
END DO
|
|
END DO; END DO
|
|
ENDIF
|
|
!
|
|
IF ( .NOT. l_fast_exchanges ) THEN
|
|
IF( nimpp + jpi - 1 /= jpiglo ) THEN
|
|
endloop = jpi
|
|
ELSE
|
|
endloop = jpi - nn_hls
|
|
ENDIF
|
|
IF( nimpp >= Ni0glo/2+2 ) THEN
|
|
startloop = 1
|
|
ELSEIF( nimpp+jpi-1 >= Ni0glo/2+2 .AND. nimpp < Ni0glo/2+2 ) THEN
|
|
startloop = Ni0glo/2+2 - nimpp + nn_hls
|
|
ELSE
|
|
startloop = endloop + 1
|
|
ENDIF
|
|
IF( startloop <= endloop ) THEN
|
|
DO jl = 1, ipl; DO jk = 1, ipk
|
|
DO ji = startloop, endloop
|
|
iju = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 2
|
|
ARRAY_IN(ji,jpj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,nn_hls+1,jk,jl,jf)
|
|
END DO
|
|
END DO; END DO
|
|
ENDIF
|
|
ENDIF
|
|
!
|
|
END SELECT
|
|
!
|
|
CASE DEFAULT ! * closed : the code probably never go through
|
|
!
|
|
WRITE(*,*) 'lbc_nfd_nogather_generic: You should not have seen this print! error?', npolj
|
|
!
|
|
END SELECT ! npolj
|
|
!
|
|
END DO ! End jf loop
|
|
END SUBROUTINE ROUTINE_NFD
|
|
#undef PRECISION
|
|
#undef ARRAY_TYPE
|
|
#undef ARRAY_IN
|
|
#undef NAT_IN
|
|
#undef SGN_IN
|
|
#undef J_SIZE
|
|
#undef K_SIZE
|
|
#undef L_SIZE
|
|
#undef F_SIZE
|
|
#undef ARRAY2_TYPE
|
|
#undef ARRAY2_IN
|