C*****FILE RPVAX05.F
C.....INFERENCE ON THE MEAN, UXF, AND STANDARD DEVIATION, SXF, OF A
C     LOGNORMAL DISTRIBUTION OF FACTORS OF INCREASE (LAMBDA) FROM
C     OBSERVATION OF A TRAJECTORY OF POPULATION CENSUSES WITH NO CENSUS
C     ERROR, WHERE DEMOGRAPHIC STOCHASTICITY (AMONG INDIV INDIVIDUALS)
C     IS IGNORED.
C     THE PRIOR IS THE CONVENTIONAL INDEPENDENT VAGUE PRIOR ON THE
C     LOG SPACE (NORMAL) DISTRIBUTION: PRIOR ON ULF IS UNIFORM, PRIOR ON
C     SLF IS THAT VARIANCE HAS PROBABILITY PROPORTIONAL TO ITS RECIPROCAL
C.....THE REPORTING PARAMETERS ARE
C       PRV(1)=UXF   MEAN OF THE LOGNORMAL DISTRIBUTION OF LAMBDA
C       PRV(2)=SXF   STD OF THE LOGNORMAL DISTRIBUTION OF LAMBDA
C.....THE DATA ARE RECEIVED FROM A DATA FILE, NAMED IN THE JOB FILE,
C     ORGANIZED AS ONE CENSUS OBSERVATION PER RECORD.
C*****
C     VERSION OF APR 26, 2011
C*****
C=====THE FOLLOWING BLOCK MUST NOT BE ALTERED==========================
      SUBROUTINE MTGIN(LUNS,LUNF,SPV,NDT,MDT,DTV,CFNAM,FWV,IWV)
C*****JOB-SPECIFIC DEDICATED SUBROUTINE THAT INITIALIZES FIXED PARAMETERS
C     FOR PROGRAM MTG
C.....GIVEN
C     LUNS   DEVICE NUMBER FOR SCREEN, PRESUMED OPEN
C     LUNF   DEVICE NUMBER FOR OUTPUT FILE, PRESUMED OPEN
C     SPV    VECTOR OF FIXED PARAMETER VALUES, READ FROM JOB FILE
C     NDT    NUMBER OF OBSERVATIONS IN DATA, SPECIFIED IN JOB FILE
C     MDT    NUMBER OF VARIABLES PER OBSERVATION IN DATA, SPECIFIED
C             IN JOB FILE
C     DTV    FLOATING POINT ARRAY OF DATA ELEMENTS, IN SINGLE SUBSCRIPT
C             STORAGE, WHERE ELEMENT IJ=(I-1)*M+J  IS THE J'TH VARIABLE
C             FROM OBSERVATION I, AS READ FROM THE DATA FILE SPECIFIED
C             IN THE JOB FILE
C.....SELF-IDENTIFIES BY WRITING NAME OF THE FILE OF JOB-SPECIFIC
C     SUBROUTINES, AS HARD CODED IN THE FIRST USER-MODIFIABLE
C     EXECUTABLE STATEMENT, TO LUNS AND LUNF, AND
C.....RETURNS
C     CFNAM  CHARACTER*8 NAME, SET IN THE FIRST USER-MODIFIABLE
C             EXECUTABLE STATEMENT, THAT MUST MATCH THE JOB SPECIFIC
C             SUBROUTINE FILE NAME SPECIFIED IN THE JOB FILE, AND MUST 
C             MATCH THE FILE NAME OF THE ACTUAL FILE (THIS FILE) CONTAINING
C             THE SOURCE CODE FOR MTGIN AND MTGPP
C     SPV    POSSIBLY REARRANGED, TRANSFORMED, SUBSET OR AUGMENTED; WILL
C             BE COMMUNICATED TO SUBROUTINE MTGPP IN THIS FORM
C     DTV    POSSIBLY REARRANGED, TRANSFORMED, SUBSET OR AUGMENTED; WILL
C             BE COMMUNICATED TO SUBROUTINE MTGPP IN THIS FORM
C     FWV    VECTOR AVAILABLE FOR FLOATING POINT WORKSPACE AND COMMUNICATING
C             ADDITIONAL FLOATING POINT VALUES TO SUBROUTINE MTGPP
C     IWV    VECTOR AVAILABLE FOR INTEGER WORKSPACE AND COMMUNICATING
C             INTEGER VALUES TO SUBROUTINE MTGPP
C*****
      CHARACTER*8 CFNAM
      DIMENSION DTV(1),SPV(1),FWV(1),IWV(1)
C=====JOB SPECIFIC CODE BLOCK BEGINS HERE==================================
C.....SELF-IDENTIFY WITH CHARACTER STRING OF UP TO 8 CHARACTERS
C     IN SINGLE QUOTES (MANDATORY).
C     DO NOT CHANGE THE NAME OF THE VARIABLE CFNAM
C.....
      CFNAM='RPVAX05 '
C.....CONVERT VECTOR NDT CENSUSES TO VECTOR OF (NDT-1) LOG FACTORS
C     OF INCREASE, AND STORE IN FWV
C.....
      J=0
      DO 1010 I=2,NDT
      J=J+1
      F=DTV(I)/DTV(J)
      FWV(J)=ALOG(F)
 1010 CONTINUE
C.....STORE SAMPLE SIZE OF LOG LAMBDAS IN IWV(1)
      NDTM=NDT-1
      IWV(1)=NDTM
C.....CONVERT SAMPLE SIZE OF LOG LAMBDAS TO FLOATING POINT, STORE IN SPV(1)
      FNDTM=FLOAT(NDTM)
      SPV(1)=FNDTM
C========END THIS BLOCK OF JOB SPECIFIC CODE============================
 9999 RETURN
      END
C-----
      SUBROUTINE MTGPP(NDT,MDT,DTV,NN,PRV,SPV,FWV,IWV,PPP,IFLG)
C*****LOG PROPORTIONAL POSTERIOR PROBABILITY FOR PROGRAM MTG
C.....GIVEN
C     NDT    NUMBER OF OBSERVATIONS IN DATA, SPECIFIED IN THE JOB FILE
C     MDT    NUMBER OF VARIABLES PER OBSERVATION IN DATA, SPECIFIED
C             IN THE JOB FILE
C     DTV    FLOATING POINT ARRAY OF DATA ELEMENTS, IN SINGLE SUBSCRIPT
C             STORAGE, WHERE ELEMENT IJ=(I-1)*M+J  IS THE J'TH VARIABLE
C             FROM OBSERVATION I, AS READ FROM THE DATA FILE SPECIFIED
C             IN THE JOB FILE (AND POSSIBLY MODIFIED BY MTGIN)
C     NN     NUMBER OF UNKNOWN PARAMETERS FOR INFERENCE, SPECIFIED
C             IN THE JOB FILE
C     PRV    VECTOR CURRENT TRIAL VALUES OF THE NN PARAMETERS
C     SPV    VECTOR OF FIXED PARAMETER VALUES, AS SPECIFIED IN THE
C             JOB FILE AND POSSIBLY MODIFIED IN MTGIN
C     FWV    VECTOR OF FLOATING WORKSPACE AND POSSIBLE FLOATING POINT
C             VALUES COMMUNICATED FROM SUBROUTINE MTGIN
C     IWV    VECTOR OF INTEGER WORKSPACE AND POSSIBLE INTEGER VALUES 
C             COMMUNICATED FROM SUBROUTINE MTGIN
C.....RETURNS
C     PPP    LOG PROPORTIONAL POSTERIOR PROBABILITY OF SELECTED
C             PARAMETER COMPONENT, OR IF J=0 OF ENTIRE PARAMETER VECTOR
C     IFLG   FLAG: 0 SIGNALS ZERO PROBABILITY, 1 OTHERWISE
C*****
      DIMENSION DTV(1),PRV(1),SPV(1),FWV(1),IWV(1)
C========BEGIN BLOCK OF JOB-SPECIFIC CODE===============================
C.....UNLOAD PARAMETER VALUES
      UXF=PRV(1)
      SXF=PRV(2)
C.....CHECK FOR IMPOSSIBLE STANDARD DEVIATION
      IF (SXF-1.0E-37) 1010,1010,1020
 1010 IFLG=0
      GO TO 9999
C.....CONVERT TO LOGNORMAL PARAMETERS IN THE LOG SPACE
 1020 CALL LNSPC(UXF,SXF,ULF,SLF)
C.....UNLOAD SAMPLE SIZE OF LAMBDAS
      NS=IWV(1)
      FNS=SPV(1)
C.....INITIATE LOG PROPORTIONAL POSTERIOR PROBABILITY
      PPP=0.0
C.....CUMULATE LOG LIKELIHOOD CONTRIBUTIONS OF EXPONENT TERM
      DO 1030 I=1,NS
      XI=FWV(I)
      PPP=PPP-((XI-ULF)/SLF)**2
 1030 CONTINUE
C.....NORMALIZE LOG LIKELIHOOD BY STD DEV TERM
      ALS=ALOG(SLF)
      PPP=PPP/2.0-FNS*ALS
C.....ADD CONTRIBUTION OF LOG PRIOR ON S
      PPP=PPP-ALS
C.....LOG PROPORTIONAL POSTERIOR PROBABILITY IS COMPLETE
      IFLG=1
C========END THIS BLOCK OF JOB SPECIFIC CODE============================
 9999 RETURN
      END
C*****
C     END OF FILE
C*****