      SUBROUTINE MCMCSTEP(PAR,PROB,NPROB,IFAIL)

      IMPLICIT NONE

      INTEGER IFAIL,I,NTOT,IDUM,TOTMIN,TOTMAX,NMAX,NPROB
      INTEGER M1FLAG,M2FLAG,M3FLAG,MHDFLAG,MHUFLAG
      INTEGER MSFLAG,AKFLAG,ALFLAG,OMGFLAG,MAFLAG,MOFLAG
      INTEGER MCFLAG,NSUSY,NGUT,NMES
      PARAMETER (NSUSY=14,NGUT=21,NMES=20)

      DOUBLE PRECISION PAR(*),PROB(*),P,RAN2,XDUM,PP
      DOUBLE PRECISION FTSUSY(NSUSY+2),FTGUT(NGUT+2),FTMES(NMES+2)
      DOUBLE PRECISION SMASS(3),PMASS(2),CMASS,SCOMP(3,3),PCOMP(2,2)
      DOUBLE PRECISION MGL,MCHA(2),U(2,2),V(2,2),MNEU(5),NEU(5,5)
      DOUBLE PRECISION MUR,MUL,MDR,MDL,MLR,MLL,MNL
      DOUBLE PRECISION MST1,MST2,MSB1,MSB2,MSL1,MSL2,MSNT
      DOUBLE PRECISION CST,CSB,CSL,MSMU1,MSMU2,MSNM,CSMU,Q2
      DOUBLE PRECISION RMST1,RMST2,S2T,RMSB1,RMSB2,S2B,XT,XB
      DOUBLE PRECISION XIF,XIS,MUP,MSP,M3H
      DOUBLE PRECISION MHmin,MHmax,chi2max,chi2gam,chi2bb,chi2zz
      DOUBLE PRECISION LCEN,LDEV,KCEN,KDEV,TBCEN,TBDEV,MUCEN,MUDEV
      DOUBLE PRECISION ALCEN,ALDEV,AKCEN,AKDEV,XIFCEN,XIFDEV,XISCEN
      DOUBLE PRECISION XISDEV,MUPCEN,MUPDEV,MSPCEN,MSPDEV,M3HCEN
      DOUBLE PRECISION M3HDEV,MACEN,MADEV,MPCEN,MPDEV,M1CEN,M1DEV
      DOUBLE PRECISION M2CEN,M2DEV,M3CEN,M3DEV,XCEN,XDEV,X,LMIN,KMIN
      DOUBLE PRECISION TBMIN,MUMIN,ALMIN,AKMIN,XIFMIN,XISMIN,MUPMIN
      DOUBLE PRECISION MSPMIN,M3HMIN,MAMIN,MPMIN,M1MIN,M2MIN,M3MIN
      DOUBLE PRECISION AQCEN,AQDEV,AQMIN,MQCEN,MQDEV,MQMIN
      DOUBLE PRECISION BRJJ(5),BREE(5),BRMM(5),BRLL(5)
      DOUBLE PRECISION BRCC(5),BRBB(5),BRTT(5),BRWW(3),BRZZ(3)
      DOUBLE PRECISION BRGG(5),BRZG(5),BRHHH(4),BRHAA(3,3)
      DOUBLE PRECISION BRHCHC(3),BRHAZ(3,2),BRAHA(3),BRAHZ(2,3)
      DOUBLE PRECISION BRHCW(5),BRHIGGS(5),BRNEU(5,5,5),BRCHA(5,3)
      DOUBLE PRECISION BRHSQ(3,10),BRHSL(3,7),BRASQ(2,2),BRASL(2)
      DOUBLE PRECISION BRSUSY(5),WIDTH(5)
      DOUBLE PRECISION CU(5),CD(5),CV(3),CJ(5),CG(5),CB(5)

      COMMON/BRN/BRJJ,BREE,BRMM,BRLL,BRCC,BRBB,BRTT,BRWW,
     . BRZZ,BRGG,BRZG,BRHHH,BRHAA,BRHCHC,BRHAZ,BRAHA,BRAHZ,
     . BRHCW,BRHIGGS,BRNEU,BRCHA,BRHSQ,BRHSL,BRASQ,BRASL,
     . BRSUSY,WIDTH
      COMMON/REDCOUP/CU,CD,CV,CJ,CG
      COMMON/CB/CB
      COMMON/SUSYEXT/XIF,XIS,MUP,MSP,M3H
      COMMON/HIGGSPEC/SMASS,SCOMP,PMASS,PCOMP,CMASS
      COMMON/SUSYSPEC/MGL,MCHA,U,V,MNEU,NEU
      COMMON/SFSPEC/MUR,MUL,MDR,MDL,MLR,MLL,MNL,
     . MST1,MST2,MSB1,MSB2,MSL1,MSL2,MSNT,
     . CST,CSB,CSL,MSMU1,MSMU2,MSNM,CSMU
      COMMON/RADCOR/RMST1,RMST2,S2T,RMSB1,RMSB2,S2B,XT,XB
      COMMON/HIGGSFIT/MHmin,MHmax,chi2max,chi2gam,chi2bb,chi2zz
      COMMON/MCMCPAR/LCEN,LDEV,KCEN,KDEV,TBCEN,TBDEV,MUCEN,MUDEV,
     . ALCEN,ALDEV,AKCEN,AKDEV,XIFCEN,XIFDEV,XISCEN,XISDEV,MUPCEN,
     . MUPDEV,MSPCEN,MSPDEV,M3HCEN,M3HDEV,MACEN,MADEV,MPCEN,MPDEV,
     . M1CEN,M1DEV,M2CEN,M2DEV,M3CEN,M3DEV,XCEN,XDEV,X,LMIN,KMIN,
     . TBMIN,MUMIN,ALMIN,AKMIN,XIFMIN,XISMIN,MUPMIN,MSPMIN,M3HMIN,
     . MAMIN,MPMIN,M1MIN,M2MIN,M3MIN,AQCEN,AQDEV,AQMIN,MQCEN,MQDEV,MQMIN
      COMMON/FINETUN/FTSUSY,FTGUT,FTMES
      COMMON/SCANFLAGS/M1FLAG,M2FLAG,M3FLAG,MHDFLAG,MHUFLAG,
     . MSFLAG,AKFLAG,ALFLAG
      COMMON/FLAGS/OMGFLAG,MAFLAG,MOFLAG
      COMMON/STEPS/NTOT,IDUM,TOTMIN,TOTMAX,NMAX
      COMMON/MCFLAG/MCFLAG

      X=0d0

      IF(IFAIL.EQ.9.OR.IFAIL.GE.11)THEN
       X=1d40
      ENDIF

      IF(IFAIL.EQ.1.OR.IFAIL.EQ.3.OR.IFAIL.EQ.5.OR.IFAIL.EQ.7)THEN
       X=X+(2d0-SMASS(1))*1d20
      ENDIF
      IF(IFAIL.EQ.2.OR.IFAIL.EQ.3.OR.IFAIL.EQ.6.OR.IFAIL.EQ.7)THEN
       X=X+(2d0-PMASS(1))*1d20
      ENDIF
      IF(IFAIL.EQ.4.OR.IFAIL.EQ.5.OR.IFAIL.EQ.6.OR.IFAIL.EQ.7)THEN
       X=X+(2d0-CMASS)*1d20
      ENDIF

      IF(IFAIL.EQ.8)THEN
       X=MIN(X,RMST1)
       X=MIN(X,RMSB1)
       X=MIN(X,MST1)
       X=MIN(X,MST2)
       X=MIN(X,MSB1)
       X=MIN(X,MSB2)
       X=MIN(X,MUL)
       X=MIN(X,MUR)
       X=MIN(X,MDL)
       X=MIN(X,MDR)
       X=MIN(X,MSL1)
       X=MIN(X,MSNT)
       X=MIN(X,MSMU1)
       X=MIN(X,MSNM)
       X=MIN(X,MLR)
       X=MIN(X,MLL)
       X=MIN(X,MNL)
       X=(1d0-X)*1d20
      ENDIF

      IF(IFAIL.EQ.10)THEN
       DO I=1,NPROB
        X=X+DABS(PROB(I))
       ENDDO
       IF(X.NE.0d0)X=(1d0+X)*1d10
      ENDIF

      IF(MCFLAG.EQ.1)THEN
       IF(FTSUSY(NSUSY+1).GT.1d3)THEN
        X=X+(FTSUSY(NSUSY+1)/1d3)*1d5
       ENDIF
       X=X+1d0
      ELSEIF(MCFLAG.EQ.2)THEN
       X=X+FTSUSY(NSUSY+1)
      ELSE
       X=X+1d0
      ENDIF

      PP=(X-XCEN)/(.28d0*XDEV*MIN(X,XCEN))
      PP=MAX(PP,-8d0*DLOG(10d0))
      PP=MIN(PP,8d0*DLOG(10d0))
      P=1d0/(1d0+DEXP(PP))
      XDUM=RAN2(IDUM)
!      WRITE(0,*)"X",XCEN,X
!      WRITE(0,*)"P",P,XDUM
      IF(P.GE.XDUM)THEN
!       WRITE(0,*)"OK",IFAIL
       XCEN=X
       TBCEN=PAR(3)
       IF(M1FLAG.EQ.1)THEN
        M1CEN=PAR(20)
       ENDIF
       M2CEN=PAR(21)
       IF(M3FLAG.EQ.1)THEN
        M3CEN=PAR(22)
       ENDIF
       LCEN=PAR(1)
       KCEN=PAR(2)
       MUCEN=PAR(4)
       IF(MOD(MAFLAG,3).EQ.0)THEN
        ALCEN=PAR(5)
        XIFCEN=XIF
       ELSEIF(MOD(MAFLAG,3).EQ.1)THEN
        MACEN=PAR(23)
        XIFCEN=XIF
       ELSE
        ALCEN=PAR(5)
        MACEN=PAR(23)
       ENDIF
       IF(MAFLAG/3.EQ.0)THEN
        AKCEN=PAR(6)
        XISCEN=XIS
       ELSEIF(MAFLAG/3.EQ.1)THEN
        MPCEN=PAR(24)
        XISCEN=XIS
       ELSE
        AKCEN=PAR(6)
        MPCEN=PAR(24)
       ENDIF
       MUPCEN=MUP
       MSPCEN=MSP
       M3HCEN=M3H
       AQCEN=PAR(12)
       MQCEN=DSQRT(PAR(7))
      ELSE
!       WRITE(0,*)"NO",IFAIL
      ENDIF
!      WRITE(0,*)""
!      WRITE(0,*)""

      END


! Associate creates an alias for expressions or variables.
program assoc
implicit none
integer, allocatable :: u(:)
u = [4,9]
associate (v => u)
v = v - 2
print*,v ! 2 7
print*,u ! 2 7
associate (w => [4,9])
print*,w
! w = w - 2 ! illegal since w set to a constant expression
end associate
end associate
end program assoc


      program salida_de_un_bucle
        implicit none
        integer :: i
        do i=1, 100
          if (i>20) then
            exit !Para de imprimir números por favor
          end if
          print *,i
        end do
        print *,i ! Aquí _i_ vale 21
      end program salida_de_un_bucle


program hello_parallel
! to compile this code
! gfortran -fopenmp hello_parallel.f90
use OMP_LIB  ! Fortran library for parallel OpenMP execution
implicit none
  integer   :: nprocs,myproc

!$OMP PARALLEL   PRIVATE(myproc)
myproc = OMP_GET_THREAD_NUM()
write(*,*)'ID: ', myproc, 'hello world'

nprocs = OMP_GET_NUM_THREADS()
if (myproc == 0) write(*,*) 'There are ', nprocs, ' for this program'
!$OMP END PARALLEL
end program hello_parallel


! chk_pointer_dim.f90 --
!     Check: does the compiler support a 2D pointer being associated to a 1D array?
!
!     Note: this is described in the document n1729.pdf by John Reid on Fortran 2008
!     as being allowed in Fortran 2003
!
program chk_pointer_dim
    implicit none

    real, dimension(100), target  :: array
    real, dimension(:,:), pointer :: matrix

    call random_number( array )

    matrix(1:20,1:5) => array

    array(1)  = 1.0
    array(21) = 2.0
    array(41) = 3.0

    write( *, '(a)' )        'Two-dimensional pointer, pointing to one-dimensional array'
    write( *, '(a,i5)' )     'Shape 1D array:  ', shape(array)
    write( *, '(a,2i5)' )    'Shape 2D matrix: ', shape(matrix)
    write( *, '(a,5f10.4)' ) 'Values: ', matrix(1,1:5)

    ! This doesn't work:
    ! write( *, '(a,l)' )   'Associated?      ', associated(matrix,array)

end program chk_pointer_dim