Changeset 2269 for trunk/LMDZ.GENERIC/libf

Timestamp:

Mar 27, 2020, 5:44:49 PM (5 years ago)

Author:

emillour

Message:

Generic GCM:

• Cleanup OpenMP statements in callcorrk.F90 and also use "call abort_physic" instead of "stop" or "call abort"

EM

File:

• trunk/LMDZ.GENERIC/libf/phystd/callcorrk.F90 (modified) (18 diffs)

trunk/LMDZ.GENERIC/libf/phystd/callcorrk.F90

@@ -135 +135 @@
       REAL*8,allocatable,save :: wbari(:,:,:)
       REAL*8,allocatable,save :: wbarv(:,:,:)
+!$OMP THREADPRIVATE(dtaui,dtauv,cosbv,cosbi,wbari,wbarv)
       REAL*8,allocatable,save :: tauv(:,:,:)
       REAL*8,allocatable,save :: taucumv(:,:,:)
       REAL*8,allocatable,save :: taucumi(:,:,:)
-
+!$OMP THREADPRIVATE(tauv,taucumv,taucumi)
       REAL*8 tauaero(L_LEVELS,naerkind)
       REAL*8 nfluxtopv,nfluxtopi,nfluxtop,fluxtopvdn
@@ -158 +159 @@
       real*8,allocatable,save :: taugsurf(:,:)
       real*8,allocatable,save :: taugsurfi(:,:)
+!$OMP THREADPRIVATE(taugsurf,taugsurfi)
       real*8 qvar(L_LEVELS)   ! Mixing ratio of variable component (mol/mol).
 
@@ -167 +169 @@
       real*8,save,allocatable ::  QSIAER(:,:,:)
       real*8,save,allocatable ::  GIAER(:,:,:)
-
+!$OMP THREADPRIVATE(QXVAER,QSVAER,GVAER,QXIAER,QSIAER,GIAER)
       real, dimension(:,:,:), save, allocatable :: QREFvis3d
       real, dimension(:,:,:), save, allocatable :: QREFir3d
-!$OMP THREADPRIVATE(QXVAER,QSVAER,GVAER,QXIAER,QSIAER,GIAER,QREFvis3d,QREFir3d)
+!$OMP THREADPRIVATE(QREFvis3d,QREFir3d)
 
 
@@ -177 +179 @@
       character(len=10) :: tmp1
       character(len=10) :: tmp2
+      character(len=100) :: message
+      character(len=10),parameter :: subname="callcorrk"
 
       ! For fixed water vapour profiles.
@@ -224 +228 @@
 
          if(naerkind.gt.4)then
-            print*,'Code not general enough to deal with naerkind > 4 yet.'
-            call abort
+            message='Code not general enough to deal with naerkind > 4 yet.'
+            call abort_physic(subname,message,1)
          endif
          call su_aer_radii(ngrid,nlayer,reffrad,nueffrad)
@@ -264 +268 @@
 
          if((igcm_h2o_vap.eq.0) .and. varactive)then
-            print*,'varactive in callcorrk but no h2o_vap tracer.'
-            stop
+            message='varactive in callcorrk but no h2o_vap tracer.'
+            call abort_physic(subname,message,1)
          endif
 
@@ -279 +283 @@
             ! Test of incompatibility : if global1d is true, there should not be any diurnal cycle.
             if (global1d.and.diurnal) then
-               print*,'if global1d is true, diurnal must be set to false'
-               stop
+               message='if global1d is true, diurnal must be set to false'
+               call abort_physic(subname,message,1)
             endif
 
@@ -476 +480 @@
                   do nw=1,L_NSPECTV
                      if(qsvaer(k,nw,iaer).gt.1.05*qxvaer(k,nw,iaer))then
-                        print*,'Serious problems with qsvaer values' 
-                        print*,'in callcorrk'
-                        call abort
+                        message='Serious problems with qsvaer values' 
+                        call abort_physic(subname,message,1)
                      endif
                      if(qsvaer(k,nw,iaer).gt.qxvaer(k,nw,iaer))then
@@ -487 +490 @@
                   do nw=1,L_NSPECTI 
                      if(qsiaer(k,nw,iaer).gt.1.05*qxiaer(k,nw,iaer))then
-                        print*,'Serious problems with qsiaer values'
-                        print*,'in callcorrk'
-                        call abort
+                        message='Serious problems with qsvaer values' 
+                        call abort_physic(subname,message,1)
                      endif
                      if(qsiaer(k,nw,iaer).gt.qxiaer(k,nw,iaer))then
@@ -602 +604 @@
       
          if(.not.global1d)then ! garde-fou/safeguard added by MT (to be removed in the future)
-            write(*,*) 'You have to fix mu0, '
-            write(*,*) 'the cosinus of the solar angle'
-            stop
+           message='You have to fix mu0, the cosinus of the solar angle'
+           call abort_physic(subname,message,1)
          endif
          
@@ -632 +633 @@
             
             if(nq.gt.1)then
-               print*,'Need 1 tracer only to run kcm1d.e' 
-               stop
+               message='Need 1 tracer only to run kcm1d.e' 
+               call abort_physic(subname,message,1)
             endif
             
@@ -648 +649 @@
             qvar(1)=qvar(2)
 
-            print*,'Warning: reducing qvar in callcorrk.'
-            print*,'Temperature profile no longer consistent ', &
+            write(*,*)trim(subname),' :Warning: reducing qvar in callcorrk.'
+            write(*,*)trim(subname),' :Temperature profile no longer consistent ', &
                    'with saturated H2O. qsat=',satval
                    
@@ -728 +729 @@
          print*,'Minimum pressure is outside the radiative'
          print*,'transfer kmatrix bounds, exiting.'
-         call abort
+         message="Minimum pressure outside of kmatrix bounds"
+         call abort_physic(subname,message,1)
       elseif(plevrad(L_LEVELS).gt.pgasmax)then
          print*,'Maximum pressure is outside the radiative'
          print*,'transfer kmatrix bounds, exiting.'
-         call abort
+         message="Minimum pressure outside of kmatrix bounds"
+         call abort_physic(subname,message,1)
       endif
 
@@ -743 +746 @@
             print*,"tgasmin=",tgasmin
             if (strictboundcorrk) then
-              call abort
+              message="Minimum temperature outside of kmatrix bounds"
+              call abort_physic(subname,message,1)
             else
               print*,'***********************************************'
@@ -758 +762 @@
             print*,"tgasmax=",tgasmax
             if (strictboundcorrk) then
-              call abort
+              message="Maximum temperature outside of kmatrix bounds"
+              call abort_physic(subname,message,1)
             else
               print*,'***********************************************'
@@ -776 +781 @@
             print*,"tgasmin=",tgasmin
             if (strictboundcorrk) then
-              call abort
+              message="Minimum temperature outside of kmatrix bounds"
+              call abort_physic(subname,message,1)
             else
               print*,'***********************************************'
@@ -791 +797 @@
             print*,"tgasmax=",tgasmax
             if (strictboundcorrk) then
-              call abort
+              message="Maximum temperature outside of kmatrix bounds"
+              call abort_physic(subname,message,1)
             else
               print*,'***********************************************'
@@ -899 +906 @@
             print*,'temp=   ',pt(ig,:)
             print*,'pplay=  ',pplay(ig,:)
-            call abort
+            message="Achtung! fluxtop_dn has lost the plot!"
+            call abort_physic(subname,message,1)
          endif