TAP_support/ADFirstAidKit/testpushpop.f90

b4daa24319 Shre*0001 !                TESTING TAPENADE PUSH/POP MECHANISM
                0002 !     ===========================================================
                0003 !
                0004 ! Tests randomly chosen sequences of PUSH/POP, on randomly chosen
                0005 ! scalars and arrays of random types. Tests PUSH/POP sequences that
                0006 ! happen during checkpointing. Tests the "repeated access" mechanism
                0007 ! that is necessary for snapshot-LOOK and for Fixed-point adjoints.
                0008 !
                0009 ! Does not test pointer PUSH/POP. Anyway, here we are only concerned
                0010 ! with sizes, so testing on int*8 and int*4 should test just as well.
                0011 !
                0012 ! This test is random: generates PUSH/POP of random sequences of variables.
                0013 ! The sequence of variables corresponding to a "*" or a "(" in the
                0014 ! CODE structure string depends only on the SEED and on the position of the
                0015 ! symbol in the CODE string.
                0016 ! The test will be identical for identical CODE string and SEED.
                0017 !
                0018 ! Syntax: $> testpushpop F "*(* 3[* (*) 5[* (*)]]*) * L(*) *" 49
                0019 !  -- 1st arg is F or C to test with adBuffer.f or adBuffer.c
                0020 !  -- 3rd arg is the SEED for random
                0021 !  -- 2nd arg is the CODE structure string
                0022 !    -- * is a plain code portion, causing PUSH and POP of a sequence of variables
                0023 !    -- (CODE) is a checkpointed CODE, implying a snapshot
                0024 !    -- L(CODE) is a checkpointed CODE with a bwd and a fwd snapshots
                0025 !      * fwd snapshot sequence depends on the position of the "("
                0026 !      * bwd snapshot sequence depends on the position of the "L"
                0027 !    -- n[CODE] tells that the bwd sweep of CODE will be accessed repeatedly n times,
                0028 !      thus reading n times each pushed value.
                0029 !
                0030 ! Compiling: $> gfortran testpushpop.f90 adStack.c -o testpushpop
                0031 !
                0032 ! Running (see testpushpop.sh): $> testpushpop.sh | grep Error
                0033
                0034 MODULE TESTPUSHPOPUTILS
                0035
                0036   LOGICAL :: TRACEON = .false.
                0037
                0038   INTEGER*4 :: ARRAYI4(5000), RECVARRAYI4(5000)
                0039   INTEGER*8 :: ARRAYI8(5000), RECVARRAYI8(5000)
                0040   REAL*4    :: ARRAYR4(5000), RECVARRAYR4(5000)
                0041   REAL*8    :: ARRAYR8(5000), RECVARRAYR8(5000)
                0042   COMPLEX*8    :: ARRAYC8(5000), RECVARRAYC8(5000)
                0043   COMPLEX*16    :: ARRAYC16(5000), RECVARRAYC16(5000)
                0044   CHARACTER(len=5000) :: ARRAYCHAR, RECVARRAYCHAR
                0045   INTEGER*4 :: FLOWDIRECTION, RECVFLOWDIRECTION
                0046   LOGICAL :: BOOLEAN, RECVBOOLEAN
                0047
                0048   CHARACTER(len=500) :: givenCode
                0049   INTEGER :: codeLength
                0050
                0051   INTEGER*4 :: givenSeed, seed1, seed2
                0052
                0053   ! proportions in % of int4,+int8,+real4,+real8,+complex8,+complex16,+characters,+bits
                0054   ! the last one, being the total of all, must be 100:
                0055   INTEGER :: trajtypes(8)=(/30,35,50,80,83,85,90,100/)
                0056   INTEGER ::  snptypes(8)=(/30,35,55,90,93,95,100,100/)
                0057   INTEGER :: snpatypes(8)=(/30,35,55,90,93,95,100,100/)
                0058   INTEGER :: snpbtypes(8)=(/30,35,55,90,93,95,100,100/)
                0059
                0060 CONTAINS
                0061   ! My pseudo-random generator. Can probably be improved!
                0062   SUBROUTINE nextrandom(seed)
                0063     INTEGER*4 :: seed
                0064     seed = MOD(seed*(1+seed), 32768)
                0065   END SUBROUTINE nextrandom
                0066
                0067   ! Random integer between 0 and imax-1 using random seed1 :
                0068   INTEGER*4 FUNCTION drawinteger(imax)
                0069     INTEGER :: imax
                0070     CALL nextrandom(seed1)
                0071     drawinteger = MOD(seed1,imax)
                0072   END FUNCTION drawinteger
                0073
                0074   ! returns the value of random seed1 :
                0075   INTEGER*4 FUNCTION getseed1()
                0076     getseed1 = seed1
                0077   END FUNCTION getseed1
                0078
                0079   REAL*8 FUNCTION mkr8(seed,mult)
                0080     INTEGER :: seed
                0081     REAL*8 :: mult, tmp
                0082     tmp = seed*mult
                0083     if (tmp<0) tmp=-tmp
                0084     mkr8 = SQRT(tmp)
                0085   END FUNCTION mkr8
                0086
                0087   REAL*4 FUNCTION mkr4(seed,mult)
                0088     INTEGER :: seed
                0089     REAL*4 :: mult, tmp
                0090     tmp = seed*mult
                0091     if (tmp<0) tmp=-tmp
                0092     mkr4 = SQRT(tmp)
                0093   END FUNCTION mkr4
                0094
                0095   ! All "fill" functions: for each basic type,
                0096   ! (in int4, int8, real4, real8, complex8, complex16, characters, bits)
                0097   ! fills (a "length" first elements of) this type's corresponding
                0098   ! global storage variable with some pseudo-random values
                0099   ! computed with internal random var "seed2", initialized with "seed".
                0100   ! The "random" quality of these values is not very critical.
                0101
                0102   SUBROUTINE fillboolean(seed)
                0103     INTEGER :: seed,tmp
                0104     seed2 = 2+4*seed
                0105     CALL nextrandom(seed2)
                0106     if (seed2>=0) then
                0107        tmp=seed2
                0108     else
                0109        tmp=-seed2
                0110     endif
                0111     BOOLEAN = (MOD(tmp,256).ge.128) !! Build a vaguely random boolean (i.e. LOGICAL)
                0112   END SUBROUTINE fillboolean
                0113
                0114   SUBROUTINE fillcontrolNb(length, seed)
                0115     INTEGER :: length, seed, tmp
                0116     seed2 = 2+4*seed
                0117     CALL nextrandom(seed2)
                0118     if (seed2>=0) then
                0119        tmp=seed2
                0120     else
                0121        tmp=-seed2
                0122     endif
                0123     FLOWDIRECTION = MOD(tmp,2**length) !! Build a vaguely random INTEGER*4 coded with "length" bits
                0124   END SUBROUTINE fillcontrolNb
                0125
                0126   SUBROUTINE fillchararray(length, seed)
                0127     INTEGER :: length, seed, i, tmp
                0128     seed2 = 2+4*seed
                0129     do i=1,length
                0130        CALL nextrandom(seed2)
                0131        if (seed2>=0) then
                0132           tmp=seed2
                0133        else
                0134           tmp=-seed2
                0135        endif
                0136        ARRAYCHAR(i:i) = CHAR(33+MOD(tmp,94)) !! Build a vaguely random CHARACTER between ascii 33 and 126
                0137     end do
                0138   END SUBROUTINE fillchararray
                0139
                0140   SUBROUTINE fillc8array(length, seed)
                0141     INTEGER :: length, seed, i
                0142     REAL*8 :: rpart, ipart
                0143     seed2 = 2+4*seed
                0144     do i=1,length
                0145        CALL nextrandom(seed2)
                0146        rpart = mkr4(seed2,1.2_4) !! Build a vaguely random REAL*4
                0147        CALL nextrandom(seed2)
                0148        ipart = mkr4(seed2,1.2_4) !! Build a vaguely random REAL*4
                0149        ARRAYC8(i) = CMPLX(rpart,ipart,8)
                0150     end do
                0151   END SUBROUTINE fillc8array
                0152
                0153   SUBROUTINE fillc16array(length, seed)
                0154     INTEGER :: length, seed, i
                0155     REAL*8 :: rpart, ipart
                0156     seed2 = 2+4*seed
                0157     do i=1,length
                0158        CALL nextrandom(seed2)
                0159        rpart = mkr8(seed2,1.2_8) !! Build a vaguely random REAL*8
                0160        CALL nextrandom(seed2)
                0161        ipart = mkr8(seed2,1.2_8) !! Build a vaguely random REAL*8
                0162        ARRAYC16(i) = CMPLX(rpart,ipart,16)
                0163     end do
                0164   END SUBROUTINE fillc16array
                0165
                0166   SUBROUTINE filli4array(length, seed)
                0167     INTEGER :: length, seed, i
                0168     seed2 = 2+4*seed
                0169     do i=1,length
                0170        CALL nextrandom(seed2)
                0171        ARRAYI4(i) = seed2 !! Build a vaguely random INTEGER*4
                0172     end do
                0173   END SUBROUTINE filli4array
                0174
                0175   SUBROUTINE filli8array(length, seed)
                0176     INTEGER :: length, seed, tmo
                0177     seed2 = 2+4*seed
                0178     do i=1,length
                0179        CALL nextrandom(seed2)
                0180        if (seed2>=0) then
                0181           tmp=seed2
                0182        else
                0183           tmp=-seed2
                0184        endif
                0185        ARRAYI8(i) = seed2*tmp !! Build a vaguely random INTEGER*8
                0186     end do
                0187   END SUBROUTINE filli8array
                0188
                0189   SUBROUTINE fillr4array(length, seed)
                0190     INTEGER :: length, seed, i
                0191     seed2 = 2+4*seed
                0192     do i=1,length
                0193        CALL nextrandom(seed2)
                0194        ARRAYR4(i) = mkr4(seed2,1.2_4) !! Build a vaguely random REAL*4
                0195     end do
                0196   END SUBROUTINE fillr4array
                0197
                0198   SUBROUTINE fillr8array(length, seed)
                0199     INTEGER :: length, seed, i
                0200     seed2 = 2+4*seed
                0201     do i=1,length
                0202        CALL nextrandom(seed2)
                0203        ARRAYR8(i) = mkr8(seed2,1.1_8) !! Build a vaguely random REAL*8
                0204     end do
                0205   END SUBROUTINE fillr8array
                0206
                0207 END MODULE TESTPUSHPOPUTILS
                0208
                0209 PROGRAM testpushpop
                0210   USE TESTPUSHPOPUTILS
                0211   IMPLICIT NONE
                0212   INTEGER :: indexopen, indexclose
                0213   CHARACTER(len=1) :: traceOnString
                0214   CHARACTER(len=10) :: seedstring
                0215   IF (iargc().ne.3) THEN
                0216      print *,"Usage: testpushpop <T for trace> ""<CodeStructure>"" <seed>"
                0217   ELSE
                0218      CALL get_command_argument(1,traceOnString)
                0219      CALL get_command_argument(2,givenCode,codeLength)
                0220      CALL get_command_argument(3,seedstring)
                0221      READ (seedstring,'(I10)') givenSeed
                0222      TRACEON = (traceOnString.eq.'T').or.(traceOnString.eq.'t').or.(traceOnString.eq.'1')
                0223      WRITE(6,991) givenSeed,givenCode(1:codeLength)
                0224      CALL runsweep(givenCode(1:codeLength), 0, 1)
                0225      !CALL EMITSHOWSTACK("middle"//CHAR(0)) !!Trace
                0226      CALL runsweep(givenCode(1:codeLength), 0, -1)
                0227   END IF
                0228  991  FORMAT('seed=',i4,' code=',a)
                0229 END PROGRAM testpushpop
                0230
                0231 SUBROUTINE getparenthindices(code,indexopen,indexclose)
                0232   USE TESTPUSHPOPUTILS
                0233   IMPLICIT NONE
                0234   CHARACTER(len=*) :: code
                0235   INTEGER indexopen, indexclose
                0236   INTEGER index, length, depth
                0237
                0238   length = LEN(code)
                0239   index = 1
                0240 ! Advance to the open parenth or square bracket:
                0241   do while(index.le.length.and.code(index:index).ne.'('.and.code(index:index).ne.'[')
                0242      index = index+1
                0243   enddo
                0244   indexopen = index
                0245   index = index+1
                0246   depth = 1
                0247 ! Find the corresponding closing parenth or square bracket or the end of string:
                0248   do while(index.le.length.and.(depth.ne.1.or.(code(index:index).ne.')'.and.code(index:index).ne.']')))
                0249      if (code(index:index).eq.'('.or.code(index:index).eq.'[') then
                0250         depth = depth+1
                0251      else if (code(index:index).eq.')'.or.code(index:index).eq.']') then
                0252         depth = depth-1
                0253      end if
                0254      index = index+1
                0255   enddo
                0256   if (index.eq.length+1.and.depth.ne.0) then
                0257      print *,'Missing closing in CodeStructure'
                0258   end if
                0259   indexclose = index
                0260 END SUBROUTINE getparenthindices
                0261
                0262 RECURSIVE SUBROUTINE runsweep(code, globaloffset, direction)
                0263   USE TESTPUSHPOPUTILS
                0264   IMPLICIT NONE
                0265   CHARACTER(len=*) code
                0266   INTEGER globaloffset, totaloffset, direction
                0267   INTEGER index, length, repeat
                0268   INTEGER indexopen, indexclose
                0269   INTEGER ii
                0270   !print *,'            runsweep on ',code,' offset:',globaloffset
                0271   repeat = -1
                0272   index = 1
                0273   length = LEN(code)
                0274 ! Skip white spaces:
                0275   do while(index.le.length.and.(code(index:index).eq.' '.or.code(index:index).eq.'     '))
                0276      index = index+1
                0277   enddo
                0278   totaloffset = globaloffset+index
                0279
                0280 ! The next token is either '(' or 'endOfString' or [1..9] or '*' or 'L'
                0281   if (index.gt.length) then
                0282 !   do nothing and return.
                0283
                0284 ! CHECKPOINT WITH LOOK SNAPSHOT MECHANISM:
                0285   else if (code(index:index).eq.'L') then
                0286      CALL getparenthindices(code(index+1:),indexopen,indexclose)
                0287      if (direction.eq.1) then
                0288         CALL emitpushpopsequence(totaloffset, 10, snpatypes, 60, 1,'TAKE SNP A at',2)
                0289         CALL emitpushpopsequence(totaloffset+indexopen, 10, snpbtypes, 70, 1,'TAKE SNP B at',2)
                0290      end if
                0291      CALL runsweep(code(index+indexclose+1:), totaloffset+indexclose, direction)
                0292      if (direction.eq.-1) then
                0293         CALL emitpushpopsequence(totaloffset+indexopen, 10, snpbtypes, 70, -1,' POP SNP B at',-2)
                0294         CALL emitstartrepeat()
                0295         CALL emitpushpopsequence(totaloffset, 10, snpatypes, 60, -1,'LOOK SNP A at',-3)
                0296         CALL emitresetrepeat()
                0297         CALL emitendrepeat()
                0298         CALL runsweep(code(index+indexopen+1:index+indexclose-1), totaloffset+indexopen, 1)
                0299         CALL runsweep(code(index+indexopen+1:index+indexclose-1), totaloffset+indexopen, -1)
                0300         CALL emitpushpopsequence(totaloffset, 10, snpatypes, 60, -1,' POP SNP A at',-2)
                0301      end if
                0302
                0303 ! CHECKPOINT WITH PLAIN PUSH-POP SNAPSHOT:
                0304   else if (code(index:index).eq.'(') then
                0305      CALL getparenthindices(code(index:),indexopen,indexclose)
                0306      if (direction.eq.1) then
                0307         CALL emitpushpopsequence(totaloffset, 20, snptypes, 70, 1,'TAKE SNP at',2)
                0308      end if
                0309      CALL runsweep(code(index-1+indexclose+1:), totaloffset-1+indexclose, direction)
                0310      if (direction.eq.-1) then
                0311         CALL emitpushpopsequence(totaloffset, 20, snptypes, 70, -1,' POP SNP at',-2)
                0312         CALL runsweep(code(index-1+indexopen+1:index-1+indexclose-1), totaloffset-1+indexopen, 1)
                0313         CALL runsweep(code(index-1+indexopen+1:index-1+indexclose-1), totaloffset-1+indexopen, -1)
                0314      end if
                0315
                0316 ! PLAIN CODE:
                0317   else if (code(index:index).eq.'*') then
                0318      if (direction.eq.1) then
                0319         CALL emitpushpopsequence(totaloffset, 80, trajtypes, 25, 1,'PUSHes part',1)
                0320      end if
                0321      CALL runsweep(code(index+1:), totaloffset, direction)
                0322      if (direction.eq.-1) then
                0323         CALL emitpushpopsequence(totaloffset, 80, trajtypes, 25, -1,'  POPs part',-1)
                0324      end if
                0325
                0326 ! CODE WITH ONE PUSH AND REPEATED POPS (e.g. FIXED-POINT ADJOINT):
                0327   else if (code(index:index).gt.'0'.and.code(index:index).le.'9') then
                0328      READ (code(index:index),'(I1)') repeat
                0329      CALL getparenthindices(code(index+1:),indexopen,indexclose)
                0330      if (direction.eq.1) then
                0331         CALL runsweep(code(index-1+indexopen+2:index+indexclose-1), totaloffset+indexopen, 1)
                0332      endif
                0333      CALL runsweep(code(index+indexclose+1:), totaloffset+indexclose, direction)
                0334      if (direction.eq.-1) then
                0335         CALL emitstartrepeat()
                0336         DO ii=1,repeat
                0337            CALL runsweep(code(index-1+indexopen+2:index+indexclose-1), totaloffset+indexopen, -1)
                0338            if (ii.ne.repeat) then
                0339               CALL emitresetrepeat()
                0340            else
                0341               CALL emitendrepeat()
                0342            endif
                0343         ENDDO
                0344      end if
                0345
                0346   else
                0347      print *,'Unexpected CodeStructure substring:',code(index:)
                0348   end if
                0349 END SUBROUTINE runsweep
                0350
                0351 ! index is the index in the code string of the "*" that stands
                0352 !  for this pushpop sequence. Index is used as the random seed.
                0353 ! ppmax is the max number of push'es or pop's in sequence
                0354 ! proportiontypes is the array of proportions in % of
                0355 ! (int4,+int8,+real4,+real8,+complex8,+complex16,+characters,+bits)
                0356 ! the last one, being the total of all, must be 100.
                0357 ! action is 1 for PUSH and -1 for POP
                0358 SUBROUTINE emitpushpopsequence(index, ppmax, proportiontypes, proportionarrays, action, msg, op)
                0359   USE TESTPUSHPOPUTILS
                0360   IMPLICIT NONE
                0361   INTEGER :: index, ppmax, proportiontypes(8), proportionarrays, action, op
                0362   CHARACTER(*) :: msg
                0363   INTEGER :: number, sort, isarray, arraylen, i
                0364   INTEGER :: sorts(200), sizes(200), seeds(200)
                0365   INTEGER :: iterfrom, iterto, iterstride
                0366   ! initialize random seed1 using only index & givenSeed
                0367   seed1 = 2+4*index*(givenSeed+index)
                0368   number = drawinteger(ppmax)
                0369   DO i=1,number
                0370      sort = drawinteger(100)
                0371      if (sort<proportiontypes(1)) then
                0372         sorts(i) = 1
                0373      else if (sort<proportiontypes(2)) then
                0374         sorts(i) = 2
                0375      else if (sort<proportiontypes(3)) then
                0376         sorts(i) = 3
                0377      else if (sort<proportiontypes(4)) then
                0378         sorts(i) = 4
                0379      else if (sort<proportiontypes(5)) then
                0380         sorts(i) = 5
                0381      else if (sort<proportiontypes(6)) then
                0382         sorts(i) = 6
                0383      else if (sort<proportiontypes(7)) then
                0384         sorts(i) = 7
                0385      else
                0386         sorts(i) = 8
                0387      endif
                0388      isarray = drawinteger(100)
                0389      if (isarray<proportionarrays) then
                0390         if (sorts(i).eq.8) then
                0391            !Case of push/pop control, limited to 6 bits:
                0392            arraylen = drawinteger(6) !!Suggested 6
                0393         else if (sorts(i).eq.7) then
                0394            !Case of push/pop character arrays, limited to 80 bytes:
                0395            arraylen = drawinteger(80) !!Suggested 80
                0396         else
                0397            arraylen = drawinteger(33) !!Suggested 33
                0398            if (arraylen.ge.30) then
                0399               arraylen = (arraylen-30)*1000 + drawinteger(999)
                0400            else if (arraylen.ge.20) then
                0401               arraylen = (arraylen-20)*100 + drawinteger(99)
                0402            else if (arraylen.ge.10) then
                0403               arraylen = (arraylen-10)*10 + drawinteger(9)
                0404            end if
                0405         endif
                0406      else
                0407         arraylen = -1 !Means scalar
                0408      endif
                0409      sizes(i) = arraylen
                0410      seeds(i) = getseed1()+index
                0411   END DO
                0412   !CALL SHOWPUSHPOPSEQUENCE(op, index, number, sorts, sizes) !!Trace
                0413   if (action.eq.1) then
                0414      iterfrom=1
                0415      iterto=number
                0416      iterstride=1
                0417   else
                0418      iterfrom=number
                0419      iterto=1
                0420      iterstride=-1
                0421   endif
                0422   DO i=iterfrom,iterto,iterstride
                0423      SELECT CASE (sorts(i))
                0424      CASE (1) !int4
                0425         if (sizes(i).eq.-1) then
                0426            call filli4array(1, seeds(i))
                0427            if (action.eq.1) then              ! PUSH
                0428               call emitpushi4scalar()
                0429            else                               ! POP
                0430               CALL emitpopi4scalar()
                0431            endif
                0432         else
                0433            call filli4array(sizes(i), seeds(i))
                0434            if (action.eq.1) then              ! PUSH
                0435               call emitpushi4array(sizes(i))
                0436            else                               ! POP
                0437               CALL emitpopi4array(sizes(i))
                0438            endif
                0439         endif
                0440      CASE (2) !int8
                0441         if (sizes(i).eq.-1) then
                0442            call filli8array(1, seeds(i))
                0443            if (action.eq.1) then              ! PUSH
                0444               call emitpushi8scalar()
                0445            else                               ! POP
                0446               CALL emitpopi8scalar()
                0447            endif
                0448         else
                0449            call filli8array(sizes(i), seeds(i))
                0450            if (action.eq.1) then              ! PUSH
                0451               call emitpushi8array(sizes(i))
                0452            else                               ! POP
                0453               CALL emitpopi8array(sizes(i))
                0454            endif
                0455         endif
                0456      CASE (3) !real4
                0457         if (sizes(i).eq.-1) then
                0458            call fillr4array(1, seeds(i))
                0459            if (action.eq.1) then              ! PUSH
                0460               call emitpushr4scalar()
                0461            else                               ! POP
                0462               CALL emitpopr4scalar()
                0463            endif
                0464         else
                0465            call fillr4array(sizes(i), seeds(i))
                0466            if (action.eq.1) then              ! PUSH
                0467               call emitpushr4array(sizes(i))
                0468            else                               ! POP
                0469               CALL emitpopr4array(sizes(i))
                0470            endif
                0471         endif
                0472      CASE (4) !real8
                0473         if (sizes(i).eq.-1) then
                0474            call fillr8array(1, seeds(i))
                0475            if (action.eq.1) then              ! PUSH
                0476               call emitpushr8scalar()
                0477            else                               ! POP
                0478               CALL emitpopr8scalar()
                0479            endif
                0480         else
                0481            call fillr8array(sizes(i), seeds(i))
                0482            if (action.eq.1) then              ! PUSH
                0483               call emitpushr8array(sizes(i))
                0484            else                               ! POP
                0485               CALL emitpopr8array(sizes(i))
                0486            endif
                0487         endif
                0488      CASE (5) !complex8
                0489         if (sizes(i).eq.-1) then
                0490            call fillc8array(1, seeds(i))
                0491            if (action.eq.1) then              ! PUSH
                0492               call emitpushc8scalar()
                0493            else                               ! POP
                0494               CALL emitpopc8scalar()
                0495            endif
                0496         else
                0497            call fillc8array(sizes(i), seeds(i))
                0498            if (action.eq.1) then              ! PUSH
                0499               call emitpushc8array(sizes(i))
                0500            else                               ! POP
                0501               CALL emitpopc8array(sizes(i))
                0502            endif
                0503         endif
                0504      CASE (6) !complex16
                0505         if (sizes(i).eq.-1) then
                0506            call fillc16array(1, seeds(i))
                0507            if (action.eq.1) then              ! PUSH
                0508               call emitpushc16scalar()
                0509            else                               ! POP
                0510               CALL emitpopc16scalar()
                0511            endif
                0512         else
                0513            call fillc16array(sizes(i), seeds(i))
                0514            if (action.eq.1) then              ! PUSH
                0515               call emitpushc16array(sizes(i))
                0516            else                               ! POP
                0517               CALL emitpopc16array(sizes(i))
                0518            endif
                0519         endif
                0520      CASE (7) !characters
                0521         if (sizes(i).eq.-1) then
                0522            call fillchararray(1, seeds(i))
                0523            if (action.eq.1) then              ! PUSH
                0524               call emitpushcharacter()
                0525            else                               ! POP
                0526               CALL emitpopcharacter()
                0527            endif
                0528         else
                0529            call fillchararray(sizes(i), seeds(i))
                0530            if (action.eq.1) then              ! PUSH
                0531               call emitpushcharacterarray(sizes(i))
                0532            else                               ! POP
                0533               CALL emitpopcharacterarray(sizes(i))
                0534            endif
                0535         endif
                0536      CASE (8) !bits or control-flow directions
                0537         if (sizes(i).le.0) then !bits
                0538            call fillboolean(seeds(i))
                0539            if (action.eq.1) then              ! PUSH
                0540               call emitpushboolean()
                0541            else                               ! POP
                0542               CALL emitpopboolean()
                0543            endif
                0544         else  !control-flow directions
                0545            call fillcontrolNb(sizes(i), seeds(i))
                0546            if (action.eq.1) then              ! PUSH
                0547               call emitpushcontrolNb(sizes(i))
                0548            else                               ! POP
                0549               CALL emitpopcontrolNb(sizes(i))
                0550            endif
                0551         endif
                0552      END SELECT
                0553   END DO
                0554   !CALL EMITSHOWSTACKSIZE() ; !!Trace
                0555 END SUBROUTINE emitpushpopsequence
                0556
                0557 SUBROUTINE emitpushboolean()
                0558   USE TESTPUSHPOPUTILS
                0559   IMPLICIT NONE
                0560   INTEGER*4 LOCSTRB,LOCSTRO
                0561   IF (TRACEON) print *,'PUSHBOOLEAN(',BOOLEAN,') AT ',LOCSTRB(),LOCSTRO()
                0562   CALL PUSHBOOLEAN(BOOLEAN)
                0563 END SUBROUTINE emitpushboolean
                0564
                0565 SUBROUTINE emitpopboolean()
                0566   USE TESTPUSHPOPUTILS
                0567   IMPLICIT NONE
                0568   INTEGER*4 LOCSTRB,LOCSTRO
                0569   CALL POPBOOLEAN(RECVBOOLEAN)
                0570   IF (TRACEON) print *,'POPBOOLEAN(',RECVBOOLEAN,') AT ',LOCSTRB(),LOCSTRO()
                0571   if (RECVBOOLEAN.neqv.BOOLEAN) then
                0572      print *,'Error boolean pushed ',BOOLEAN,' popped ',RECVBOOLEAN,   &
                0573  &           ' seed:',givenSeed,' code:',givenCode(1:codeLength)
                0574      stop
                0575   end if
                0576 END SUBROUTINE emitpopboolean
                0577
                0578 SUBROUTINE emitpushcontrolNb(size)
                0579   USE TESTPUSHPOPUTILS
                0580   IMPLICIT NONE
                0581   INTEGER size
                0582   SELECT CASE (size)
                0583   CASE (1)
                0584      CALL PUSHCONTROL1B(FLOWDIRECTION)
                0585   CASE (2)
                0586      CALL PUSHCONTROL2B(FLOWDIRECTION)
                0587   CASE (3)
                0588      CALL PUSHCONTROL3B(FLOWDIRECTION)
                0589   CASE (4)
                0590      CALL PUSHCONTROL4B(FLOWDIRECTION)
                0591   CASE (5)
                0592      CALL PUSHCONTROL5B(FLOWDIRECTION)
                0593   CASE (6)
                0594      CALL PUSHCONTROL6B(FLOWDIRECTION)
                0595   CASE (7)
                0596      CALL PUSHCONTROL7B(FLOWDIRECTION)
                0597   CASE (8)
                0598      CALL PUSHCONTROL8B(FLOWDIRECTION)
                0599   END SELECT
                0600 END SUBROUTINE emitpushcontrolNb
                0601
                0602 SUBROUTINE emitpopcontrolNb(size)
                0603   USE TESTPUSHPOPUTILS
                0604   IMPLICIT NONE
                0605   INTEGER :: size
                0606   SELECT CASE (size)
                0607   CASE (1)
                0608      CALL POPCONTROL1B(RECVFLOWDIRECTION)
                0609   CASE (2)
                0610      CALL POPCONTROL2B(RECVFLOWDIRECTION)
                0611   CASE (3)
                0612      CALL POPCONTROL3B(RECVFLOWDIRECTION)
                0613   CASE (4)
                0614      CALL POPCONTROL4B(RECVFLOWDIRECTION)
                0615   CASE (5)
                0616      CALL POPCONTROL5B(RECVFLOWDIRECTION)
                0617   CASE (6)
                0618      CALL POPCONTROL6B(RECVFLOWDIRECTION)
                0619   CASE (7)
                0620      CALL POPCONTROL7B(RECVFLOWDIRECTION)
                0621   CASE (8)
                0622      CALL POPCONTROL8B(RECVFLOWDIRECTION)
                0623   END SELECT
                0624   if (RECVFLOWDIRECTION.ne.FLOWDIRECTION) then
                0625      print *,'Error flow direction pushed ',FLOWDIRECTION,' popped ',RECVFLOWDIRECTION,   &
                0626  &           ' seed:',givenSeed,' code:',givenCode(1:codeLength)
                0627      stop
                0628   end if
                0629 END SUBROUTINE emitpopcontrolNb
                0630
                0631 SUBROUTINE emitpushcharacter()
                0632   USE TESTPUSHPOPUTILS
                0633   IMPLICIT NONE
                0634   CALL PUSHCHARACTER(ARRAYCHAR(1:1))
                0635 END SUBROUTINE emitpushcharacter
                0636
                0637 SUBROUTINE emitpopcharacter()
                0638   USE TESTPUSHPOPUTILS
                0639   IMPLICIT NONE
                0640      CALL POPCHARACTER(RECVARRAYCHAR(1:1))
                0641   if (RECVARRAYCHAR(1:1).ne.ARRAYCHAR(1:1)) then
                0642      print *,'Error character pushed ',ARRAYCHAR(1:1),' popped ',RECVARRAYCHAR(1:1),   &
                0643  &           ' seed:',givenSeed,' code:',givenCode(1:codeLength)
                0644      stop
                0645   end if
                0646 END SUBROUTINE emitpopcharacter
                0647
                0648 SUBROUTINE emitpushcharacterarray(size)
                0649   USE TESTPUSHPOPUTILS
                0650   IMPLICIT NONE
                0651   INTEGER size
                0652   CALL PUSHCHARACTERARRAY(ARRAYCHAR, size)
                0653 END SUBROUTINE emitpushcharacterarray
                0654
                0655 SUBROUTINE emitpopcharacterarray(size)
                0656   USE TESTPUSHPOPUTILS
                0657   IMPLICIT NONE
                0658   INTEGER :: size
                0659   CALL POPCHARACTERARRAY(RECVARRAYCHAR, size)
                0660   if (RECVARRAYCHAR(1:size).ne.ARRAYCHAR(1:size)) then
                0661      print *,'Error character array pushed ',ARRAYCHAR(1:size),' popped ',RECVARRAYCHAR(1:size),   &
                0662  &           ' seed:',givenSeed,' code:',givenCode(1:codeLength)
                0663      stop
                0664   end if
                0665 END SUBROUTINE emitpopcharacterarray
                0666
                0667 SUBROUTINE emitpushc8scalar()
                0668   USE TESTPUSHPOPUTILS
                0669   IMPLICIT NONE
                0670   INTEGER*4 LOCSTRB,LOCSTRO
                0671   IF (TRACEON) print *,'PUSHCOMPLEX8(',ARRAYC8(1),') AT ',LOCSTRB(),LOCSTRO()
                0672   CALL PUSHCOMPLEX8(ARRAYC8(1))
                0673 END SUBROUTINE emitpushc8scalar
                0674
                0675 SUBROUTINE emitpopc8scalar()
                0676   USE TESTPUSHPOPUTILS
                0677   IMPLICIT NONE
                0678   INTEGER*4 LOCSTRB,LOCSTRO
                0679   CALL POPCOMPLEX8(RECVARRAYC8(1))
                0680   IF (TRACEON) print *,'POPCOMPLEX8(',RECVARRAYC8(1),') AT ',LOCSTRB(),LOCSTRO()
                0681   if (RECVARRAYC8(1).ne.ARRAYC8(1)) then
                0682      print *,'Error complex8 scalar pushed ',ARRAYC8(1),' popped ',RECVARRAYC8(1),   &
                0683  &           ' seed:',givenSeed,' code:',givenCode(1:codeLength)
                0684      stop
                0685   end if
                0686 END SUBROUTINE emitpopc8scalar
                0687
                0688 SUBROUTINE emitpushc8array(size)
                0689   USE TESTPUSHPOPUTILS
                0690   IMPLICIT NONE
                0691   INTEGER size
                0692   CALL PUSHCOMPLEX8ARRAY(ARRAYC8, size)
                0693 END SUBROUTINE emitpushc8array
                0694
                0695 SUBROUTINE emitpopc8array(size)
                0696   USE TESTPUSHPOPUTILS
                0697   IMPLICIT NONE
                0698   INTEGER :: size, i
                0699   CALL POPCOMPLEX8ARRAY(RECVARRAYC8, size)
                0700   DO i=1,size
                0701      if (RECVARRAYC8(i).ne.ARRAYC8(i)) then
                0702         print *,'Error complex8 array elem ',i,' pushed ',ARRAYC8(i),' popped ',RECVARRAYC8(i),   &
                0703  &           ' seed:',givenSeed,' code:',givenCode(1:codeLength)
                0704         stop
                0705      end if
                0706   END DO
                0707 END SUBROUTINE emitpopc8array
                0708
                0709 SUBROUTINE emitpushc16scalar()
                0710   USE TESTPUSHPOPUTILS
                0711   IMPLICIT NONE
                0712   CALL PUSHCOMPLEX16(ARRAYC16(1))
                0713 END SUBROUTINE emitpushc16scalar
                0714
                0715 SUBROUTINE emitpopc16scalar()
                0716   USE TESTPUSHPOPUTILS
                0717   IMPLICIT NONE
                0718   CALL POPCOMPLEX16(RECVARRAYC16(1))
                0719   if (RECVARRAYC16(1).ne.ARRAYC16(1)) then
                0720      print *,'Error complex16 scalar pushed ',ARRAYC16(1),' popped ',RECVARRAYC16(1),   &
                0721  &           ' seed:',givenSeed,' code:',givenCode(1:codeLength)
                0722      stop
                0723   end if
                0724 END SUBROUTINE emitpopc16scalar
                0725
                0726 SUBROUTINE emitpushc16array(size)
                0727   USE TESTPUSHPOPUTILS
                0728   IMPLICIT NONE
                0729   INTEGER size
                0730   CALL PUSHCOMPLEX16ARRAY(ARRAYC16, size)
                0731 END SUBROUTINE emitpushc16array
                0732
                0733 SUBROUTINE emitpopc16array(size)
                0734   USE TESTPUSHPOPUTILS
                0735   IMPLICIT NONE
                0736   INTEGER :: size, i
                0737   CALL POPCOMPLEX16ARRAY(RECVARRAYC16, size)
                0738   DO i=1,size
                0739      if (RECVARRAYC16(i).ne.ARRAYC16(i)) then
                0740         print *,'Error complex16 array elem ',i,' pushed ',ARRAYC16(i),' popped ',RECVARRAYC16(i),   &
                0741  &           ' seed:',givenSeed,' code:',givenCode(1:codeLength)
                0742         stop
                0743      end if
                0744   END DO
                0745 END SUBROUTINE emitpopc16array
                0746
                0747 SUBROUTINE emitpushr4scalar()
                0748   USE TESTPUSHPOPUTILS
                0749   IMPLICIT NONE
                0750   INTEGER*4 LOCSTRB,LOCSTRO
                0751   IF (TRACEON) print *,'PUSHREAL4(',ARRAYR4(1),') AT ',LOCSTRB(),LOCSTRO()
                0752   CALL PUSHREAL4(ARRAYR4(1))
                0753 END SUBROUTINE emitpushr4scalar
                0754
                0755 SUBROUTINE emitpopr4scalar()
                0756   USE TESTPUSHPOPUTILS
                0757   IMPLICIT NONE
                0758   INTEGER*4 LOCSTRB,LOCSTRO
                0759   CALL POPREAL4(RECVARRAYR4(1))
                0760   IF (TRACEON) print *,'POPREAL4(',RECVARRAYR4(1),') AT ',LOCSTRB(),LOCSTRO()
                0761   if (RECVARRAYR4(1).ne.ARRAYR4(1)) then
                0762      print *,'Error real4 scalar pushed ',ARRAYR4(1),' popped ',RECVARRAYR4(1),   &
                0763  &           ' seed:',givenSeed,' code:',givenCode(1:codeLength)
                0764      stop
                0765   end if
                0766 END SUBROUTINE emitpopr4scalar
                0767
                0768 SUBROUTINE emitpushr4array(size)
                0769   USE TESTPUSHPOPUTILS
                0770   IMPLICIT NONE
                0771   INTEGER size
                0772   INTEGER*4 LOCSTRB,LOCSTRO
                0773   IF (TRACEON) print *,'PUSHREAL4ARRAY(',size,":",ARRAYR4(1),'...) AT ',LOCSTRB(),LOCSTRO()
                0774   CALL PUSHREAL4ARRAY(ARRAYR4, size)
                0775 END SUBROUTINE emitpushr4array
                0776
                0777 SUBROUTINE emitpopr4array(size)
                0778   USE TESTPUSHPOPUTILS
                0779   IMPLICIT NONE
                0780   INTEGER :: size, i
                0781   INTEGER*4 LOCSTRB,LOCSTRO
                0782   CALL POPREAL4ARRAY(RECVARRAYR4, size)
                0783   IF (TRACEON) print *,'POPREAL4ARRAY(',size,":",RECVARRAYR4(1),'...) AT ',LOCSTRB(),LOCSTRO()
                0784   DO i=1,size
                0785      if (RECVARRAYR4(i).ne.ARRAYR4(i)) then
                0786         print *,'Error real4 array elem ',i,' pushed ',ARRAYR4(i),' popped ',RECVARRAYR4(i),   &
                0787  &           ' seed:',givenSeed,' code:',givenCode(1:codeLength)
                0788         stop
                0789      end if
                0790   END DO
                0791 END SUBROUTINE emitpopr4array
                0792
                0793 SUBROUTINE emitpushr8scalar()
                0794   USE TESTPUSHPOPUTILS
                0795   IMPLICIT NONE
                0796   INTEGER*4 LOCSTRB,LOCSTRO
                0797   IF (TRACEON) print *,'PUSHREAL8(',ARRAYR8(1),') AT ',LOCSTRB(),LOCSTRO()
                0798   CALL PUSHREAL8(ARRAYR8(1))
                0799 END SUBROUTINE emitpushr8scalar
                0800
                0801 SUBROUTINE emitpopr8scalar()
                0802   USE TESTPUSHPOPUTILS
                0803   IMPLICIT NONE
                0804   INTEGER*4 LOCSTRB,LOCSTRO
                0805   CALL POPREAL8(RECVARRAYR8(1))
                0806   IF (TRACEON) print *,'POPREAL8(',RECVARRAYR8(1),') AT ',LOCSTRB(),LOCSTRO()
                0807   if (RECVARRAYR8(1).ne.ARRAYR8(1)) then
                0808      print *,'Error real8 scalar pushed ',ARRAYR8(1),' popped ',RECVARRAYR8(1),   &
                0809  &           ' seed:',givenSeed,' code:',givenCode(1:codeLength)
                0810      stop
                0811   end if
                0812 END SUBROUTINE emitpopr8scalar
                0813
                0814 SUBROUTINE emitpushr8array(size)
                0815   USE TESTPUSHPOPUTILS
                0816   IMPLICIT NONE
                0817   INTEGER size
                0818   INTEGER*4 LOCSTRB,LOCSTRO
                0819   IF (TRACEON) print *,'PUSHREAL8ARRAY(',size,":",ARRAYR8(1),'...) AT ',LOCSTRB(),LOCSTRO()
                0820   CALL PUSHREAL8ARRAY(ARRAYR8, size)
                0821 END SUBROUTINE emitpushr8array
                0822
                0823 SUBROUTINE emitpopr8array(size)
                0824   USE TESTPUSHPOPUTILS
                0825   IMPLICIT NONE
                0826   INTEGER :: size, i
                0827   INTEGER*4 LOCSTRB,LOCSTRO
                0828   CALL POPREAL8ARRAY(RECVARRAYR8, size)
                0829   IF (TRACEON) print *,'POPREAL8ARRAY(',size,":",RECVARRAYR8(1),'...) AT ',LOCSTRB(),LOCSTRO()
                0830   DO i=1,size
                0831      if (RECVARRAYR8(i).ne.ARRAYR8(i)) then
                0832         print *,'Error real8 array elem ',i,' pushed ',ARRAYR8(i),' popped ',RECVARRAYR8(i),   &
                0833  &           ' seed:',givenSeed,' code:',givenCode(1:codeLength)
                0834         stop
                0835      end if
                0836   END DO
                0837 END SUBROUTINE emitpopr8array
                0838
                0839 SUBROUTINE emitpushi4scalar()
                0840   USE TESTPUSHPOPUTILS
                0841   IMPLICIT NONE
                0842   INTEGER*4 LOCSTRB,LOCSTRO
                0843   IF (TRACEON) print *,'PUSHINTEGER4(',ARRAYI4(1),') AT ',LOCSTRB(),LOCSTRO()
                0844   CALL PUSHINTEGER4(ARRAYI4(1))
                0845 END SUBROUTINE emitpushi4scalar
                0846
                0847 SUBROUTINE emitpopi4scalar()
                0848   USE TESTPUSHPOPUTILS
                0849   IMPLICIT NONE
                0850   INTEGER*4 LOCSTRB,LOCSTRO
                0851   CALL POPINTEGER4(RECVARRAYI4(1))
                0852   IF (TRACEON) print *,'POPINTEGER4(',RECVARRAYI4(1),') AT ',LOCSTRB(),LOCSTRO()
                0853   if (RECVARRAYI4(1).ne.ARRAYI4(1)) then
                0854      print *,'Error integer4 scalar pushed ',ARRAYI4(1),' popped ',RECVARRAYI4(1),   &
                0855  &           ' seed:',givenSeed,' code:',givenCode(1:codeLength)
                0856      stop
                0857   end if
                0858 END SUBROUTINE emitpopi4scalar
                0859
                0860 SUBROUTINE emitpushi4array(size)
                0861   USE TESTPUSHPOPUTILS
                0862   IMPLICIT NONE
                0863   INTEGER size
                0864   INTEGER*4 LOCSTRB,LOCSTRO
                0865   IF (TRACEON) print *,'PUSHINTEGER4ARRAY(',size,":",ARRAYI4(1),'...) AT ',LOCSTRB(),LOCSTRO()
                0866   CALL PUSHINTEGER4ARRAY(ARRAYI4, size)
                0867 END SUBROUTINE emitpushi4array
                0868
                0869 SUBROUTINE emitpopi4array(size)
                0870   USE TESTPUSHPOPUTILS
                0871   IMPLICIT NONE
                0872   INTEGER :: size,i
                0873   INTEGER*4 LOCSTRB,LOCSTRO
                0874   CALL POPINTEGER4ARRAY(RECVARRAYI4, size)
                0875   IF (TRACEON) print *,'POPINTEGER4ARRAY(',size,":",RECVARRAYI4(1),'...) AT ',LOCSTRB(),LOCSTRO()
                0876   DO i=1,size
                0877      if (RECVARRAYI4(i).ne.ARRAYI4(i)) then
                0878         print *,'Error integer4 array elem ',i,' pushed ',ARRAYI4(i),' popped ',RECVARRAYI4(i),   &
                0879  &           ' seed:',givenSeed,' code:',givenCode(1:codeLength)
                0880         stop
                0881      end if
                0882   END DO
                0883 END SUBROUTINE emitpopi4array
                0884
                0885 SUBROUTINE emitpushi8scalar()
                0886   USE TESTPUSHPOPUTILS
                0887   IMPLICIT NONE
                0888   INTEGER*4 LOCSTRB,LOCSTRO
                0889   IF (TRACEON) print *,'PUSHINTEGER8(',ARRAYI8(1),') AT ',LOCSTRB(),LOCSTRO()
                0890   CALL PUSHINTEGER8(ARRAYI8(1))
                0891 END SUBROUTINE emitpushi8scalar
                0892
                0893 SUBROUTINE emitpopi8scalar()
                0894   USE TESTPUSHPOPUTILS
                0895   IMPLICIT NONE
                0896   INTEGER*4 LOCSTRB,LOCSTRO
                0897   CALL POPINTEGER8(RECVARRAYI8(1))
                0898   IF (TRACEON) print *,'POPINTEGER8(',RECVARRAYI8(1),') AT ',LOCSTRB(),LOCSTRO()
                0899   if (RECVARRAYI8(1).ne.ARRAYI8(1)) then
                0900      print *,'Error integer8 scalar pushed ',ARRAYI8(1),' popped ',RECVARRAYI8(1),   &
                0901  &           ' seed:',givenSeed,' code:',givenCode(1:codeLength)
                0902      stop
                0903   end if
                0904 END SUBROUTINE emitpopi8scalar
                0905
                0906 SUBROUTINE emitpushi8array(size)
                0907   USE TESTPUSHPOPUTILS
                0908   IMPLICIT NONE
                0909   INTEGER size
                0910   CALL PUSHINTEGER8ARRAY(ARRAYI8, size)
                0911 END SUBROUTINE emitpushi8array
                0912
                0913 SUBROUTINE emitpopi8array(size)
                0914   USE TESTPUSHPOPUTILS
                0915   IMPLICIT NONE
                0916   INTEGER :: size,i
                0917   CALL POPINTEGER8ARRAY(RECVARRAYI8, size)
                0918   DO i=1,size
                0919      if (RECVARRAYI8(i).ne.ARRAYI8(i)) then
                0920         print *,'Error integer8 array elem ',i,' pushed ',ARRAYI8(i),' popped ',RECVARRAYI8(i),   &
                0921  &           ' seed:',givenSeed,' code:',givenCode(1:codeLength)
                0922         stop
                0923      end if
                0924   END DO
                0925 END SUBROUTINE emitpopi8array
                0926
                0927 SUBROUTINE emitstartrepeat()
                0928   USE TESTPUSHPOPUTILS
                0929   INTEGER*4 LOCSTRB,LOCSTRO
                0930   IF (TRACEON) print *,'adStack_startRepeat() AT ',LOCSTRB(),LOCSTRO()
                0931   CALL ADSTACK_STARTREPEAT()
                0932 END SUBROUTINE emitstartrepeat
                0933
                0934 SUBROUTINE emitresetrepeat()
                0935   USE TESTPUSHPOPUTILS
                0936   INTEGER*4 LOCSTRB,LOCSTRO
                0937   IF (TRACEON) print *,'adStack_resetRepeat() AT ',LOCSTRB(),LOCSTRO()
                0938   CALL ADSTACK_RESETREPEAT()
                0939   IF (TRACEON) print *,'-----------------------> ',LOCSTRB(),LOCSTRO()
                0940 END SUBROUTINE emitresetrepeat
                0941
                0942 SUBROUTINE emitendrepeat()
                0943   USE TESTPUSHPOPUTILS
                0944   INTEGER*4 LOCSTRB,LOCSTRO
                0945   IF (TRACEON) print *,'adStack_endRepeat() AT ',LOCSTRB(),LOCSTRO()
                0946   CALL ADSTACK_ENDREPEAT()
                0947 END SUBROUTINE emitendrepeat
                0948
                0949 !! Only for Trace:
                0950 SUBROUTINE emitshowstacksize()
                0951   USE TESTPUSHPOPUTILS
                0952   CALL ADSTACK_SHOWSTACKSIZE()
                0953 END SUBROUTINE emitshowstacksize
                0954
                0955 SUBROUTINE emitshowstack(locationName)
                0956   USE TESTPUSHPOPUTILS
                0957   CHARACTER(*) locationName
                0958   CALL ADSTACK_SHOWSTACK(locationName)
                0959 END SUBROUTINE emitshowstack