MODULE maxicosa
contains
    SUBROUTINE maxis(f_fl,maxff,minff) 
     USE icosa
     IMPLICIT NONE
 INTEGER::i,j,ij,l,ind
 TYPE(t_field),POINTER::f_fl(:) 
 REAL(rstd),POINTER::fl(:)  
 REAL(rstd)::maxf,minf 
 REAL(rstd),INTENT(OUT)::maxff,minff 
 
    maxff=-1e50
    minff=1e50 
    DO ind=1,ndomain 
     CALL swap_dimensions(ind)
     CALL swap_geometry(ind) 
     fl=f_fl(ind) 
     CALL compute_maxis(fl,maxf,minf)  
     maxff=max(maxff,maxf) 
     minff=min(minff,minf) 
    ENDDO 
   END SUBROUTINE maxis
!------------------------------------------------------------
	    SUBROUTINE maxiv(f_fu,maxuu,minuu) 
     USE icosa
     IMPLICIT NONE
 INTEGER::i,j,ij,l,ind
 TYPE(t_field),POINTER::f_fu(:) 
 REAL(rstd),POINTER::fu(:,:)  
 REAL(rstd)::maxu,minu 
 REAL(rstd),INTENT(OUT)::maxuu,minuu 
 
    maxuu=-1e50
    minuu=1e50 
    DO ind=1,ndomain 
     CALL swap_dimensions(ind)
     CALL swap_geometry(ind) 
     fu=f_fu(ind) 
     CALL compute_maxiv(fu,maxu,minu)  
	maxuu=max(maxuu,maxu) 
	minuu=min(minuu,minu) 
    ENDDO 
	END SUBROUTINE maxiv

    SUBROUTINE errornorms(f_ref,f_sim,norml1,norml2,normlf) 
     USE icosa
     IMPLICIT NONE
 INTEGER::i,j,ij,l,ind
 TYPE(t_field),POINTER::f_ref(:),f_sim(:) 
 REAL(rstd),POINTER::ref(:),sim(:)  
 REAL(rstd),INTENT(OUT)::norml1,norml2,normlf 
 REAL(rstd)::maxf,minf
 REAL(rstd)::maxff,minff
 
    norml1 = 0.0 ; norml2 = 0.0 ; normlf = 0.0
    DO ind=1,ndomain 
     CALL swap_dimensions(ind)
     CALL swap_geometry(ind) 
      ref=f_ref(ind) 
      sim=f_sim(ind) 
     CALL compute_maxis(sim,maxf,minf)  
     maxff=max(maxff,maxf) 
     minff=min(minff,minf) 
    ENDDO 
	END SUBROUTINE errornorms

	SUBROUTINE compute_maxis(fl,maxf,minf) 
	USE icosa
	IMPLICIT NONE 
	REAL(rstd),INTENT(IN)::fl(iim*jjm)
	REAL(rstd),INTENT(OUT)::maxf,minf 
	INTEGER::i,j,ij 

	maxf=-1e50
	minf= 1e50 
     DO j=jj_begin,jj_end
       DO i=ii_begin,ii_end
           ij=(j-1)*iim+i
          IF ( maxf .LT. fl(ij) ) Then 
	      maxf = fl(ij) 
	     ENDIF 
	    IF ( minf .GT. fl(ij) ) Then 
	     minf = fl(ij) 
	    ENDIF 
	   ENDDO
      ENDDO
	END SUBROUTINE compute_maxis
!------------------------------------------------------
		SUBROUTINE compute_maxiv(fu,maxu,minu) 
	USE icosa
	IMPLICIT NONE 
	REAL(rstd),INTENT(IN)::fu(3*iim*jjm,llm) 
	REAL(rstd),INTENT(OUT)::maxu,minu  
	INTEGER::i,j,ij 

     maxu=-1e50
     minu=1e50 
	DO j=jj_begin-1,jj_end+1
         DO i=ii_begin-1,ii_end+1
           ij=(j-1)*iim+i
          IF ( maxu .LT. fu(ij+u_right,llm) ) Then 
	      maxu = fu(ij+u_right,llm) 
	     ENDIF 
		IF ( maxu .LT. fu(ij+u_lup,llm) ) Then 
	      maxu = fu(ij+u_lup,llm) 
	     ENDIF
	     IF ( maxu .LT. fu(ij+u_ldown,llm) ) Then 
	      maxu = fu(ij+u_ldown,llm) 
	     ENDIF
!------------------------------
		IF ( minu .GT. fu(ij+u_right,llm) ) Then 
	      minu = fu(ij+u_right,llm) 
	     ENDIF 
		IF ( minu .GT. fu(ij+u_lup,llm) ) Then 
	      minu = fu(ij+u_lup,llm) 
	     ENDIF
	     IF ( maxu .GT. fu(ij+u_ldown,llm) ) Then 
	      minu = fu(ij+u_ldown,llm) 
	     ENDIF 
	   ENDDO
      ENDDO
	END SUBROUTINE compute_maxiv
!--------------------------------------------------
	Subroutine compute_l1(reference,simulated,nrml1)
	use icosa
	IMPLICIT NONE 
	REAL(rstd),INTENT(IN)::reference(iim*jjm) 
	REAL(rstd),INTENT(IN)::simulated(iim*jjm) 
	REAL(rstd),INTENT(OUT)::nrml1
	REAL(rstd) :: temp1,temp2
	INTEGER::i,j,ij 

	temp1 = 0.0 ; temp2 = 0.0 
	nrml1 = 0.0 
	DO j=jj_begin,jj_end
         DO i=ii_begin,ii_end
          ij=(j-1)*iim+i
	  temp1 = temp1 + abs(simulated(ij) - reference(ij))*Ai(ij) 
	  temp2 = temp2 + abs(reference(ij))*Ai(ij) 
	 END DO
	END DO
	  nrml1 = temp1/temp2 
	END SUBROUTINE compute_l1 

	Subroutine compute_l2(reference,simulated,nrml2)
	use icosa
	IMPLICIT NONE 
	REAL(rstd),INTENT(IN)::reference(iim*jjm) 
	REAL(rstd),INTENT(IN)::simulated(iim*jjm) 
	REAL(rstd),INTENT(OUT)::nrml2
	REAL(rstd) :: temp1,temp2
	INTEGER::i,j,ij 

	temp1 = 0.0 ; temp2 = 0.0 
	nrml2 = 0.0 
	DO j=jj_begin,jj_end
         DO i=ii_begin,ii_end
          ij=(j-1)*iim+i
	  temp1 = temp1 + (simulated(ij) - reference(ij))*(simulated(ij) - reference(ij))*Ai(ij) 
	  temp2 = temp2 + reference(ij)*reference(ij)*Ai(ij) 
	 END DO
	END DO
	  temp1 = sqrt(temp1) 
	  temp2 = sqrt(temp2)  
	  nrml2 = temp1/temp2 
	END SUBROUTINE compute_l2 

	Subroutine compute_lf(reference,simulated,nrmlf)
	use icosa
	IMPLICIT NONE 
	REAL(rstd),INTENT(IN)::reference(iim*jjm) 
	REAL(rstd),INTENT(IN)::simulated(iim*jjm) 
	REAL(rstd),INTENT(OUT)::nrmlf
	REAL(rstd):: difference(iim*jjm) 
	REAL(rstd) :: temp1,temp2
	INTEGER::i,j,ij 

	temp1 = 0.0 ; temp2 = 0.0 
	nrmlf = 0.0 
	
	temp1 = maxval(ABS(difference))
	temp2 = maxval(ABS(reference)) 
	  nrmlf = temp1/temp2 
	END SUBROUTINE compute_lf 
!================================================== initial0 
	 SUBROUTINE initial0(f_ps,f_phis,f_theta_rhodz,f_u, f_q)
  USE icosa
  IMPLICIT NONE
    TYPE(t_field),POINTER :: f_ps(:)
    TYPE(t_field),POINTER :: f_phis(:)
    TYPE(t_field),POINTER :: f_theta_rhodz(:)
    TYPE(t_field),POINTER :: f_u(:)
    TYPE(t_field),POINTER :: f_q(:)
  
    REAL(rstd),POINTER :: ps(:)
    REAL(rstd),POINTER :: phis(:)
    REAL(rstd),POINTER :: theta_rhodz(:,:)
    REAL(rstd),POINTER :: u(:,:)
    REAL(rstd),POINTER :: q(:,:,:)
    INTEGER :: ind
       
    DO ind=1,ndomain
      CALL swap_dimensions(ind)
      CALL swap_geometry(ind)
      ps=f_ps(ind)
      phis=f_phis(ind)
      theta_rhodz=f_theta_rhodz(ind)
      u=f_u(ind)
      q=f_q(ind)
      q=0.0
      ps=0.0
	 phis=0.0
      theta_rhodz = 0.0
	 u = 0.0
    ENDDO
  END SUBROUTINE initial0

	END MODULE maxicosa