MODULE dados
IMPLICIT NONE
PUBLIC :: Z, A, N
INTEGER :: Z, A, N
CONTAINS
   SUBROUTINE ler(Z,A,N)
   INTEGER, INTENT(OUT) :: Z, A, N
      CALL SYSTEM("CLS")
      10 FORMAT(A)
      WRITE(*,*)"    |************************************************************|"
      WRITE(*,*)"    |                                                            |"
      WRITE(*,*)"    |           MODELOS NUCLEARES: Modelo de Camadas             |"
      WRITE(*,*)"    |                   by Gilberto Orengo                       |"
      WRITE(*,*)"    |                                                            |"
      WRITE(*,*)"    |     Predicoes para Spin, Paridade e Momento magnetico      |"
      WRITE(*,*)"    |                                                            |"
      WRITE(*,*)"    |************************************************************|"
      WRITE(*,*)""
      WRITE(*,10,ADVANCE="NO")" Digite o valor de Z (numero  atomico): "
      READ(*,*)Z
      WRITE(*,10,ADVANCE="NO")" Digite o valor de A (numero de massa): "
      READ(*,*)A
      N=A-Z
      WRITE(*,*)"Numero de neutrons (N): ",N 
      WRITE(*,*)""
      WRITE(*,*)""
   END SUBROUTINE ler
END MODULE dados
!
!
PROGRAM modelo_camadas
IMPLICIT NONE
CHARACTER :: resp
CALL executa
11 FORMAT(A)
DO
WRITE(*,11,ADVANCE="NO")" Desejas fazer outro calculo? (S) ou (N): "
READ(*,'(A)')resp
IF (resp=="s".OR.resp=="S") THEN
   CALL executa
ELSE IF (resp=="n".OR.resp=="N") THEN
   EXIT
ELSE IF (resp/="n".OR.resp/="N" .OR. resp/="n".OR.resp/="S") THEN
   CYCLE
END IF
END DO
PAUSE
END PROGRAM modelo_camadas
!
!
! Subrotinas
!
!
SUBROUTINE executa()
USE dados
IMPLICIT NONE
REAL :: j, l, s=0.5, mu, gs, gl, mu1a, mu1b, mu2a, mu2b, spn, sp1a, sp2a
INTEGER :: e1, par, par1a, par2a
CHARACTER :: tipo
CHARACTER(LEN=2) :: e
CHARACTER(LEN=4) :: sp
!
20 FORMAT(A,I4,A,I1)
!
CALL ler(Z,A,N)
!
IF (Z > 112 .OR. A > 285 ) THEN
   WRITE(*,*)""
   WRITE(*,*)"Valor invalido para Z e/ou A"
   WRITE(*,*)""
ELSE IF (MOD(Z,2)==1 .AND. MOD(N,2)==0) THEN
! Proton
   CALL desdobramento(Z,l,j,e1,sp,spn,par)
   CALL calmup(s,l,j,mu)
   mu1a=mu
   gs=5.59
   gl=1.0
   CALL calmuschmidt(gl,gs,j,mu,e1)
   mu1b=mu
   WRITE(*,*)"Resultados finais ................................"
   CALL escrever(sp,par,mu1a,mu1b)
ELSE IF (MOD(Z,2)==0 .AND. MOD(N,2)==1) THEN
! Neutron
   CALL desdobramento(N,l,j,e1,sp,spn,par)
   CALL calmun(s,l,j,mu)
   mu1a=mu
   gs=-3.83
   gl=0.0
   CALL calmuschmidt(gl,gs,j,mu,e1)
   mu1b=mu
   WRITE(*,*)"Resultados finais ................................"
   CALL escrever(sp,par,mu1a,mu1b)
ELSE IF (MOD(Z,2)==1 .AND. MOD(N,2)==1) THEN
! Proton e Neutron
! Proton
   CALL desdobramento(Z,l,j,e1,sp,spn,par)
   WRITE(*,*)"[ Nucleons desemparelhados ]"
   WRITE(*,*)"Dados para o Proton ........"
   sp1a=spn
   par1a=par
   CALL calmup(s,l,j,mu)
   mu1a=mu
   gs=5.59
   gl=1.0
   CALL calmuschmidt(gl,gs,j,mu,e1)
   mu1b=mu
   CALL escrever(sp,par,mu1a,mu1b)
! Neutron
   CALL desdobramento(N,l,j,e1,sp,spn,par)
   WRITE(*,*)"Dados para o Neutron ......."
   sp2a=spn
   par2a=par
   CALL calmun(s,l,j,mu)
   mu2a=mu
   gs=-3.83
   gl=0.0
   CALL calmuschmidt(gl,gs,j,mu,e1)
   mu2b=mu
   CALL escrever(sp,par,mu2a,mu2b)
! Resultado
   WRITE(*,*)""
   WRITE(*,*)"Resultados finais combinados ....................."
   WRITE(*,*)""
   WRITE(*,*)"Possiveis Spins: ", ABS(INT(sp1a-sp2a)), "    ou    ",INT(sp1a+sp2a)
   WRITE(*,*)"Paridade: ",par1a*par2a
   WRITE(*,*)"O valor do mu eh: ", mu1a+mu2a,"muN"
   WRITE(*,*)"O valor do mu eh (por Schimdt): ", mu1b+mu2b,"muN"
   WRITE(*,*)""
ELSE IF (MOD(Z,2)==0 .AND. MOD(N,2)==0) THEN
   WRITE(*,*)""
   WRITE(*,*)"Spin: 0","  Paridade: +"
   WRITE(*,*)"O valor do mu eh: 0 muN"
   WRITE(*,*)""
ELSE
   WRITE(*,*)""
   WRITE(*,*)"Valor invalido para Z e/ou A"
   WRITE(*,*)""
END IF
END SUBROUTINE executa
!
!
SUBROUTINE calmup(s,l,j,mu)
! Calcula o momento magnetico para o proton
REAL, INTENT(IN) :: j,s,l
REAL, INTENT(OUT) :: mu
WRITE(*,*)"j = ", j,"s = ",s,"l = ", l
   mu=((5.58*(j*(j+1.0) + s*(s+1.0) - l*(l+1.0)) + (j*(j+1.0) - s*(s+1) + l*(l+1.0)))/(2.0*j*(j+1.0)))*j
WRITE(*,*)"mu = ", mu
END SUBROUTINE calmup
!
!
SUBROUTINE calmun(s,l,j,mu)
! Calcula o momento magnetico para o neutron
REAL, INTENT(IN) :: j,s,l
REAL, INTENT(OUT) :: mu
   mu=-(3.82*(j*(j+1.0) + s*(s+1.0) - l*(l+1.0)))/(2.0*j*(j+1.0))*j
END SUBROUTINE calmun
!
!
SUBROUTINE calmuschmidt(gl,gs,j,mu,e1)
! Calcula o momento magnetico pela proposta de Shmidt
REAL, INTENT(IN) :: gl, gs, j
REAL, INTENT(OUT) :: mu
INTEGER, INTENT(IN) :: e1
   IF (e1==2) THEN
   ! maior energia
      mu=j*gl + ((j)/(2.0*(j+1.0)))*(gl-gs)
   ELSE IF (e1==1) THEN
   ! menor energia
      mu=j*gl - (1.0/2.0)*(gl-gs)
   END IF
END SUBROUTINE calmuschmidt
!
!
SUBROUTINE escrever(sp,par,mu1a,mu1b)
USE dados
REAL, INTENT(IN) :: mu1a, mu1b
INTEGER, INTENT(IN) :: par
CHARACTER(LEN=4), INTENT(IN) :: sp
   WRITE(*,*)""
   WRITE(*,*)"Spin: ", sp,"  Paridade: ",par
   WRITE(*,*)"O valor do mu eh: ", mu1a,"muN"
   WRITE(*,*)"O valor do mu eh (por Schmidt): ", mu1b,"muN"
   WRITE(*,*)""
END SUBROUTINE escrever
!
!
SUBROUTINE desdobramento(nucleons,l,j,energia,spin,spinn,paridade)
! Procura o desdobramento de sub-niveis para os valores de Z e N desemparelhados
INTEGER, INTENT(IN) :: nucleons
INTEGER, INTENT(OUT) :: energia, paridade
REAL, INTENT(OUT) :: l, j, spinn
CHARACTER(LEN=4), INTENT(OUT) :: spin
!
SELECT CASE(nucleons)
   CASE(1:2)
      l=0.0     ! 1s1/2
      j=0.5
      energia=1 ! menor
      spin="1/2"
      spinn=1./2.
      paridade=+1
   CASE(3:6)
      l=1.0     ! 1p3/2
      j=1.5
      energia=1 ! menor
      spin="3/2"
      spinn=3./2.
      paridade=-1
   CASE(7:8)
      l=1.0     ! 1p1/2
      j=0.5
      energia=2 ! maior
      spin="1/2"
      spinn=1./2.
      paridade=-1
   CASE(9:14)
      l=2.0     ! 1d5/2
      j=2.5
      energia=1 ! menor
      spin="5/2"
      spinn=5./2.
      paridade=+1
   CASE(15:16)
      l=0.0     ! 2s1/2
      j=0.5
      energia=1 ! menor
      spin="1/2"
      spinn=1./2.
      paridade=+1
   CASE(17:20)
      l=2.0     ! 1d3/2
      j=1.5
      energia=2 ! maior
      spin="3/2"
      spinn=3./2.
      paridade=+1
   CASE(21:28)
      l=3.0     ! 1f7/2
      j=3.5
      energia=1 ! menor
      spin="7/2"
      spinn=7./2.
      paridade=-1
   CASE(29:32)
      l=1.0     ! 2p3/2
      j=1.5
      energia=1 ! menor
      spin="3/2"
      spinn=3./2.
      paridade=-1
   CASE(33:38)
      l=3.0     ! 1f5/2
      j=2.5
      energia=2 ! maior
      spin="5/2"
      spinn=5./2.
      paridade=-1
   CASE(39:40)
      l=1.0     ! 2p1/2
      j=0.5
      energia=2 ! maior
      spin="1/2"
      spinn=1./2.
      paridade=-1
   CASE(41:50)
      l=4.0     ! 1g9/2
      j=4.5
      energia=1 ! menor
      spin="9/2"
      spinn=9./2.
      paridade=+1
   CASE(51:58)
      l=4.0     ! 1g7/2
      j=3.5
      energia=2 ! maior
      spin="7/2"
      spinn=7./2.
      paridade=+1
   CASE(59:64)
      l=2.0     ! 2d5/2
      j=2.5
      energia=1 ! menor
      spin="5/2"
      spinn=5./2.
      paridade=-1
   CASE(65:68)
      l=2.0     ! 2d3/2
      j=1.5
      energia=2 ! maior
      spin="3/2"
      spinn=3./2.
      paridade=-1
   CASE(69:70)
      l=0.0     ! 3s1/2
      j=0.5
      energia=1 ! menor
      spin="1/2"
      paridade=+1
   CASE(71:82)
      l=5.0     ! 1h11/2
      j=5.5
      energia=1 ! menor
      spin="11/2"
      spinn=11./2.
      paridade=-1
   CASE(83:92)
      l=5.0     ! 1h9/2
      j=4.5
      energia=2 ! maior
      spin="9/2"
      spinn=9./2.
      paridade=-1
   CASE(93:100)
      l=3.0     ! 2f7/2
      j=3.5
      energia=1 ! menor
      spin="7/2"
      spinn=7./2.
      paridade=-1
   CASE(101:104)
      l=1.0     ! 3p3/2
      j=1.5
      energia=1 ! menor
      spin="3/2"
      spinn=3./2.
      paridade=-1
   CASE(105:110)
      l=3.0     ! 2f5/2
      j=2.5
      energia=2 ! maior
      spin="9/2"
      spinn=9./2.
      paridade=-1
   CASE(111:112)
      l=1.0     ! 3p1/2
      j=0.5
      energia=2 ! maior
      spin="1/2"
      spinn=1./2.
      paridade=-1
   CASE(113:126)
      l=6.0     ! 1i13/2
      j=6.5
      energia=1 ! menor
      spin="13/2"
      spinn=13./2.
      paridade=+1
   CASE(127:136)
      l=4.0     ! 2g9/2
      j=4.5
      energia=1 ! menor
      spin="9/2"
      spinn=9./2.
      paridade=+1
   CASE(137:142)
      l=2.0     ! 3d5/2
      j=2.5
      energia=1 ! menor
      spin="5/2"
      spinn=5./2.
      paridade=+1
   CASE(143:154)
      l=6.0     ! 1i11/2
      j=5.5
      energia=2 ! maior
      spin="11/2"
      spinn=11./2.
      paridade=+1
   CASE(155:162)
      l=4.0     ! 2g7/2
      j=3.5
      energia=2 ! maior
      spin="7/2"
      spinn=7./2.
      paridade=-1
   CASE(163:164)
      l=0.0     ! 4s1/2
      j=0.5
      energia=1 ! menor
      spin="1/2"
      spinn=1./2.
      paridade=+1
   CASE(165:168)
      l=2.0     ! 3d3/2
      j=1.5
      energia=2 ! maior
      spin="3/2"
      spinn=3./2.
      paridade=+1
   CASE(169:184)
      l=7.0     ! 1j15/2
      j=7.5
      energia=1 ! menor
      spin="15/2"
      spinn=15./2.
      paridade=-1
END SELECT
END SUBROUTINE