program pilgrim c ****** This program is the Phase I slave program to be run on additional c ****** processors. It calculates the optical potential and sends it to c ****** the Master program. include '/usr/local/include/fpvm3.h' implicit real*8 (a-h, k, o-z) real*8 imtij, Mp, MN, k, kp, kpts, k1, imwave real*8 Rcoul, Rcut integer info, nproc, nhost, msgty, mytid, bufid, consti dimension nifty(20) dimension kpts(97) dimension Vr(7), Vi(7), f(43,88,7), Vll(100,2,7) dimension rewave(40,160), imwave(40,160), tawave(7,160) dimension taxwve(7,160), kap(160) dimension consti(30), constr(30) common /params/ hbarc, pi, Mp, MN, nz, na, nes, nwaves common /switch/ nifty common /sizes/ achp, acmp, wsp, achn, acmn, wsn common /ranges/ Rcoul, Rcut common /inputs/ aax, bbx, ccx, ddx, eex, ffx, lmax, ggx, hhx common /tape/ rewave, imwave, tawave, taxwve, kap c >>> FIRST EXECUTABLE STATEMENT <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< c ****** The program is enrolled in PVM and receives its process I.D. call pvmfmytid( mytid ) c ****** It then learns it's parent's, the Master's I.D. number. *** call pvmfparent( mtid ) c ****** The next subroutine receives the parameters and data from the c ***** Master program with which to calculate the potential. ******** call pvmfrecv( mtid, 1, info ) call pvmfunpack( INTEGER4, consti(1), 28, 1, info) call pvmfunpack( REAL8, constr(1), 13, 1, info) do 21 ii =1, 30 if (ii.eq.1) n1 = consti(ii) if (ii.eq.1) Mp = constr(ii) if (ii.eq.2) ldmax = consti(ii) if (ii.eq.2) MN = constr(ii) if (ii.eq.3) lborn = consti(ii) if (ii.eq.3) k1 = constr(ii) if (ii.eq.4) nwaves = consti(ii) if (ii.eq.4) Rcut = constr(ii) if (ii.eq.5) nz = consti(ii) if (ii.eq.5) Rcoul = constr(ii) if (ii.eq.6) na = consti(ii) if (ii.eq.6) hbarc = constr(ii) if (ii.eq.7) nes = consti(ii) if (ii.eq.7) pi = constr(ii) if (ii.eq.8) achp = constr(ii) if (ii.eq.9) acmp = constr(ii) if (ii.eq.10) wsp = constr(ii) if (ii.eq.11) achn = constr(ii) if (ii.eq.12) acmn = constr(ii) if (ii.eq.13) wsn = constr(ii) if (ii.eq.28) i1 = consti(ii) if (ii.gt.7.and.ii.lt.28) then nifty(ii-7) = consti(ii) endif 21 continue call pvmfunpack( REAL8, rewave(1,1), 6400, 1, info) call pvmfunpack( REAL8, imwave(1,1), 6400, 1, info) call pvmfunpack( REAL8, tawave(1,1), 1120, 1, info) call pvmfunpack( REAL8, taxwve(1,1), 1120, 1, info) call pvmfunpack( REAL8, kpts(1), n1, 1, info) call pvmfunpack( REAL8, kap(1), 160, 1, info) lmax = ldmax do 240 i2 = 1,n1 k = kpts(i2) kp = kpts(i1) lmax = ldmax + 4 xMN = MN c *** Do loop over l *** do 230 ldum = 1,ldmax IF ( (ldum .gt. lborn) $ .AND. $ ( (i1 + i2) .ne. (2 * n1) )) go to 230 j1 = ldum Urc = 0. Uic = 0. Urs = 0. Uis = 0. c *** Set up potential needed for this l in integral equation c *** N.B. the f is + ImV as stored. npot1 = 2 * ldum c *** c *** Vll(neles, re/im, nspin-mp) = Vll(50,2,6) c *** lmas2 = ldmax + 2 IF (ldum .eq. 1) then call VStoVL( Vll, k, kp, lmas2, k1 ) endif c *** Proton c *** c *** Nifty(6) = 8, full 1/2 * 1/2 c *** This is for singlet ld2 = ldum + 2 f(i2,npot1-1,1) = Vll( ldum, 1, 6 ) f(i2,npot1,1) = Vll( ldum, 2, 6 ) ff1 = f(i2,npot1-1,1) ff2 = f(i2,npot1,1) c *** c *** Coupled channels pp c *** Store matrices with new, nonlinear forms c *** c *** RHL code for proton He3 nspin c *** 1- singlet 2- triplet l=j 3- triplet j=l+1 (l,l) c *** 4- j=l+1 (l+2,l) 5- j=l+1 (l+2,l+2) 6- j=l+1 (l,l+2) c *** N.B. switch l values so nspin = 3, 4, 5, 6 all same j - as in main c *** M.P. code versus RHL 1=6 2=4 3=3 4=2 5=5 6=1 c *** c********* tvm ST Mixing 9/8/92 Yet another convention. ************* c 7-triplet l = j 2- triplet singlet 1s 8-singlet triplet s1 *********************************************************************** c 2's to sevens in f( , )'s below c 4's and 6's interchanges in code below in f( , )'s c twelve ff's to f's tm 9/24/90 f(i2,npot1-1,7) = Vll(ldum,1,4) f(i2,npot1,7) = Vll(ldum,2,4) c *** Special Paez coding store r0(11) in r0(00) IF (ldum.eq.1) then f(i2,npot1-1,7) = Vll(2,1,5) f(i2,npot1,7) = Vll(2,2,5) endif f(i2,npot1-1,4) = Vll(ld2,1,1) f(i2,npot1,4) = Vll(ld2,2,1) f(i2,npot1-1,3) = Vll(ldum,1,3) f(i2,npot1,3) = Vll(ldum,2,3) f(i2,npot1-1,5) = Vll(ld2,1,5) f(i2,npot1,5) = Vll(ld2,2,5) f(i2,npot1-1,6) = Vll(ldum,1,2) f(i2,npot1,6) = Vll(ldum,2,2) c *********** New TS mixing tvm 9/8/92 *************************** f(i2,npot1-1,2) = Vll(ldum,1,7) f(i2,npot1,2) = Vll(ldum,2,7) c *** Not special Paez coding any longer 226 nnn = npot1 - 1 IF (kp .ne. k1 .OR. ldum .ne. 1) go to 230 n = nifty(6) c *** Do loop over ldum ENDS 230 continue 240 continue c ******** This variable serves as a test of the transmission between *** c ******** Master and slave. It can be checked more easily than the *** c ******** results of the entire program. *** testy = kap(i1) c ********* It's now time to send the finished potential back to the c ********* Master. The variable f contains all potential data. infoger = n1 * 7 * ldmax * 2 call pvmfinitsend(PVMRAW, bufid) call pvmfpack( REAL8,testy, 1, 1, info) call pvmfpack( REAL8, f(1,1,1), infoger, 1, info) call pvmfsend( mtid, i1, info) call pvmfexit(info) return end