C------------------------------------------------------------------------------ C ngrav.for C------------------------------------------------------------------------------ C 25 Mar 2010 - Added argument gravity to CALL PGRAVg C 23 Mar 2010 - Added CALL PGRAVg and CALL PGRAVa C 23 Mar 2010 - Added argument gravity to ENTRY GRAVg C 23 Mar 2010 - Added ENTRY GRAVg (with argument) C 23 Mar 2010 - Added ENTRY GRAVa (without argument) C 19 Mar 2008 - Changed GID to GVID for consistency C 19 Jul 2006 - Separated igrav (no argument) and igravg (w. argument) C 13 July 2006 - CORRECTIONS C 12 July 2006 C------------------------------------------------------------------------------ SUBROUTINE NGRAV C------------------------------------------------------------------------------ C GENERIC GRAVITY MODEL implicit double precision (a-h,o-z) C TYPE :: model CHARACTER :: model_name REAL(KIND=8) :: data_id CHARACTER :: pert_name REAL(KIND=8) :: pert_id END TYPE model TYPE (model) :: modgg C For gravity, the following variables represent first derivatives of the C the three components (r, theta, and phi), NOT SECOND DERIVATIVES. C Example: pthtm is the partial derivative of g_sub_th with respect to time. TYPE :: gravity_and_derivs_1 REAL(KIND=8) :: gs,gsr,gsth,gsph REAL(KIND=8) :: ptm,pr,pth,pph REAL(KIND=8) :: prtm,prr,prth,prph REAL(KIND=8) :: pthtm,pthr,pthth,pthph REAL(KIND=8) :: pphtm,pphr,pphth,pphph END TYPE TYPE (gravity_and_derivs_1) :: gravity C COMMON DECK "WW" INSERTED HERE common/ww/ dum(10),maxw,w(1000) C C GRAVITY 600-624 EQUIVALENCE (W(600),GVMODEL),(W(601),GFORM),(W(602),GVID) ! 19 Mar 2008 C C COMMON DECK "GV" INSERTED HERE DOUBLE PRECISION modgv COMMON/GV/MODGV(4) 1 ,GV ,PGVTM ,PGVR ,PGVTH ,PGVPH 2 ,GVR ,PGVRTM ,PGVRR ,PGVRTH ,PGVRPH 3 ,GVTH,PGVTHTM,PGVTHR,PGVTHTH,PGVTHPH 4 ,GVPH,PGVPHTM,PGVPHR,PGVPHTH,PGVPHPH C COMMON DECK "B13" INSERTED HERE INTEGER TMX,TNTBL,TITBL,TFRMTBL,IDST(10) COMMON/B13/TMX,TNTBL(10),TITBL(10),TFRMTBL(10),TGP(262) EQUIVALENCE (TGP,IDST),(ANT,TGP(11)) INTEGER TYMX,TYNTBL(10),TYITBL(10),TYFRMTBL(10) C DATA RECOGG/0.d0/ DATA TYMX/1/ DATA TYNTBL/1,11,8*0/ DATA TYITBL/1,9*0/ DATA TYFRMTBL/1,9*0/ C ENTRY SETGRAV TMX=TYMX CALL IMOVE(TNTBL,TYNTBL,10) CALL IMOVE(TITBL,TYITBL,10) CALL IMOVE(TFRMTBL,TYFRMTBL,10) ! 13 July 2006 CALL SETPGRAV ! 13 July 2006 RETURN C C------------------------------------------------------------------------------ ENTRY IGRAV IF(idint(RECOGG) .NE. idint(GVMODEL)) 1 CALL RERROR('NGRAV ','WRNG MODEL',RECOGG) C MODGV(1)=5HNGRAV MODGV(2)=GVID ! 19 Mar 2008 CALL IPGRAV ! 13 July 2006 RETURN C------------------------------------------------------------------------------ ENTRY igravg(modgg) ! 19 Jul 2006 IF (gvmodel /= 0.d0) THEN PRINT *,' Model check number mismatch: ' STOP ' W(600) should be 0 if you are using model NGRAV.' ENDIF modgg%model_name = 'NGRAV' modgg%data_id = gvid modgg%pert_name = '' modgg%pert_id = 0.d0 CALL ipgravg(modgg) ! 25 January 2006 RETURN C C------------------------------------------------------------------------------ ENTRY grav(gravity) ! 23 Mar 2010 ENTRY gravg(gravity) ! 23 Mar 2010 CALL PGRAVg(gravity) ! 25 Mar 2010 RETURN ENTRY GRAVa ! 23 Mar 2010 CALL PGRAVa ! 23 Mar 2010 RETURN C------------------------------------------------------------------------------ END SUBROUTINE NGRAV ! 23 Mar 2010 C------------------------------------------------------------------------------