Changeset 2471 for LMDZ5/branches/testing/libf/dynphy_lonlat/phylmd/etat0phys_netcdf.F90

Timestamp:

Mar 18, 2016, 12:09:23 PM (9 years ago)

Author:

Laurent Fairhead

Message:

Merged trunk changes r2434:2457 into testing branch

Location:

LMDZ5/branches/testing

Files:

• . (modified) (1 prop)
• libf/dynphy_lonlat/phylmd/etat0phys_netcdf.F90 (modified) (5 diffs)

LMDZ5/branches/testing/libf/dynphy_lonlat/phylmd/etat0phys_netcdf.F90

@@ -86 +86 @@
   USE conf_phys_m, ONLY: conf_phys
   USE init_ssrf_m, ONLY: start_init_subsurf
+  !use ioipsl_getincom
   IMPLICIT NONE
 !-------------------------------------------------------------------------------
@@ -97 +98 @@
   LOGICAL            :: read_mask
   REAL               :: phystep, dummy
-  REAL, DIMENSION(SIZE(masque,1),SIZE(masque,2)) :: masque_tmp
+  REAL, DIMENSION(SIZE(masque,1),SIZE(masque,2)) :: masque_tmp,phiso
   REAL, DIMENSION(klon)               :: sn, rugmer, run_off_lic_0, fder
   REAL, DIMENSION(klon,nbsrf)         :: qsolsrf, snsrf
@@ -115 +116 @@
   INTEGER :: read_climoz                        !--- Read ozone climatology
   REAL    :: alp_offset
+  LOGICAL :: filtre_oro=.false.
 
   deg2rad= pi/180.0
@@ -142 +144 @@
   read_mask=ANY(masque/=-99999.); masque_tmp=masque
   CALL start_init_orog(rlonv, rlatu, phis, masque_tmp)
+
+  CALL getin('filtre_oro',filtre_oro)
+  IF (filtre_oro) CALL filtreoro(size(phis,1),size(phis,2),phis,masque_tmp,rlatu)
+
   WRITE(fmt,"(i4,'i1)')")iml ; fmt='('//ADJUSTL(fmt)
   IF(.NOT.read_mask) THEN                       !--- Keep mask form orography
@@ -447 +453 @@
 !
 !-------------------------------------------------------------------------------
+!
+!*******************************************************************************
+
+SUBROUTINE filtreoro(imp1,jmp1,phis,masque,rlatu)
+
+IMPLICIT NONE
+
+  INTEGER imp1,jmp1
+  REAL, DIMENSION(imp1,jmp1) :: phis,masque
+  REAL, DIMENSION(jmp1) :: rlatu
+  REAL, DIMENSION(imp1) :: wwf
+  REAL, DIMENSION(imp1,jmp1) :: phiso
+  INTEGER :: ifiltre,ifi,ii,i,j
+  REAL :: coslat0,ssz
+
+  coslat0=0.5
+  phiso=phis
+  do j=2,jmp1-1
+     print*,'avant if ',cos(rlatu(j)),coslat0
+     if (cos(rlatu(j))<coslat0) then
+         ! nb de pts affectes par le filtrage de part et d'autre du pt
+         ifiltre=(coslat0/cos(rlatu(j))-1.)/2.
+         wwf=0.
+         do i=1,ifiltre
+            wwf(i)=1.
+         enddo
+         wwf(ifiltre+1)=(coslat0/cos(rlatu(j))-1.)/2.-ifiltre
+         do i=1,imp1-1
+            if (masque(i,j)>0.9) then
+               ssz=phis(i,j)
+               do ifi=1,ifiltre+1
+                  ii=i+ifi
+                  if (ii>imp1-1) ii=ii-imp1+1
+                  ssz=ssz+wwf(ifi)*phis(ii,j)
+                  ii=i-ifi
+                  if (ii<1) ii=ii+imp1-1
+                  ssz=ssz+wwf(ifi)*phis(ii,j)
+               enddo
+               phis(i,j)=ssz*cos(rlatu(j))/coslat0
+            endif
+         enddo
+         print*,'j=',j,coslat0/cos(rlatu(j)), (1.+2.*sum(wwf))*cos(rlatu(j))/coslat0
+     endif
+  enddo
+  call dump2d(imp1,jmp1,phis,'phis ')
+  call dump2d(imp1,jmp1,masque,'masque ')
+  call dump2d(imp1,jmp1,phis-phiso,'dphis ')
+
+END SUBROUTINE filtreoro
 
 
 END MODULE etat0phys
-!
-!*******************************************************************************
-